* wrong dir

git-svn-id: branches/unitrw@1549 -

.gitattributes

@@ -77,576 +77,6 @@ compiler/charset.pas svneol=native#text/plain
 compiler/cmsgs.pas svneol=native#text/plain
 compiler/comphook.pas svneol=native#text/plain
 compiler/compiler.pas svneol=native#text/plain
-compiler/compiler/COPYING -text
-compiler/compiler/MPWMake -text
-compiler/compiler/Makefile svneol=native#text/plain
-compiler/compiler/Makefile.fpc svneol=native#text/plain
-compiler/compiler/README -text
-compiler/compiler/aasmbase.pas svneol=native#text/plain
-compiler/compiler/aasmtai.pas svneol=native#text/plain
-compiler/compiler/aggas.pas svneol=native#text/plain
-compiler/compiler/alpha/aasmcpu.pas svneol=native#text/plain
-compiler/compiler/alpha/agaxpgas.pas svneol=native#text/plain
-compiler/compiler/alpha/aoptcpu.pas svneol=native#text/plain
-compiler/compiler/alpha/aoptcpub.pas svneol=native#text/plain
-compiler/compiler/alpha/aoptcpuc.pas svneol=native#text/plain
-compiler/compiler/alpha/aoptcpud.pas svneol=native#text/plain
-compiler/compiler/alpha/cgcpu.pas svneol=native#text/plain
-compiler/compiler/alpha/cpubase.pas svneol=native#text/plain
-compiler/compiler/alpha/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/alpha/cpunode.pas svneol=native#text/plain
-compiler/compiler/alpha/cpupara.pas svneol=native#text/plain
-compiler/compiler/alpha/cpupi.pas svneol=native#text/plain
-compiler/compiler/alpha/cpuswtch.pas svneol=native#text/plain
-compiler/compiler/alpha/cputarg.pas svneol=native#text/plain
-compiler/compiler/alpha/radirect.pas svneol=native#text/plain
-compiler/compiler/alpha/rasm.pas svneol=native#text/plain
-compiler/compiler/alpha/rgcpu.pas svneol=native#text/plain
-compiler/compiler/alpha/tgcpu.pas svneol=native#text/plain
-compiler/compiler/aopt.pas svneol=native#text/plain
-compiler/compiler/aoptbase.pas svneol=native#text/plain
-compiler/compiler/aoptcs.pas svneol=native#text/plain
-compiler/compiler/aoptda.pas svneol=native#text/plain
-compiler/compiler/aoptobj.pas svneol=native#text/plain
-compiler/compiler/arm/aasmcpu.pas svneol=native#text/plain
-compiler/compiler/arm/agarmgas.pas svneol=native#text/plain
-compiler/compiler/arm/aoptcpu.pas svneol=native#text/plain
-compiler/compiler/arm/aoptcpub.pas svneol=native#text/plain
-compiler/compiler/arm/aoptcpuc.pas svneol=native#text/plain
-compiler/compiler/arm/aoptcpud.pas svneol=native#text/plain
-compiler/compiler/arm/armatt.inc svneol=native#text/plain
-compiler/compiler/arm/armatts.inc svneol=native#text/plain
-compiler/compiler/arm/armins.dat -text
-compiler/compiler/arm/armnop.inc svneol=native#text/plain
-compiler/compiler/arm/armop.inc svneol=native#text/plain
-compiler/compiler/arm/armtab.inc svneol=native#text/plain
-compiler/compiler/arm/cgcpu.pas svneol=native#text/plain
-compiler/compiler/arm/cpubase.pas svneol=native#text/plain
-compiler/compiler/arm/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/arm/cpunode.pas svneol=native#text/plain
-compiler/compiler/arm/cpupara.pas svneol=native#text/plain
-compiler/compiler/arm/cpupi.pas svneol=native#text/plain
-compiler/compiler/arm/cpuswtch.pas svneol=native#text/plain
-compiler/compiler/arm/cputarg.pas svneol=native#text/plain
-compiler/compiler/arm/itcpugas.pas svneol=native#text/plain
-compiler/compiler/arm/narmadd.pas svneol=native#text/plain
-compiler/compiler/arm/narmcal.pas svneol=native#text/plain
-compiler/compiler/arm/narmcnv.pas svneol=native#text/plain
-compiler/compiler/arm/narmcon.pas svneol=native#text/plain
-compiler/compiler/arm/narminl.pas svneol=native#text/plain
-compiler/compiler/arm/narmmat.pas svneol=native#text/plain
-compiler/compiler/arm/raarm.pas svneol=native#text/plain
-compiler/compiler/arm/raarmgas.pas svneol=native#text/plain
-compiler/compiler/arm/rarmcon.inc svneol=native#text/plain
-compiler/compiler/arm/rarmdwa.inc svneol=native#text/plain
-compiler/compiler/arm/rarmnor.inc svneol=native#text/plain
-compiler/compiler/arm/rarmnum.inc svneol=native#text/plain
-compiler/compiler/arm/rarmrni.inc svneol=native#text/plain
-compiler/compiler/arm/rarmsri.inc svneol=native#text/plain
-compiler/compiler/arm/rarmsta.inc svneol=native#text/plain
-compiler/compiler/arm/rarmstd.inc svneol=native#text/plain
-compiler/compiler/arm/rarmsup.inc svneol=native#text/plain
-compiler/compiler/arm/rgcpu.pas svneol=native#text/plain
-compiler/compiler/assemble.pas svneol=native#text/plain
-compiler/compiler/browcol.pas svneol=native#text/plain
-compiler/compiler/browlog.pas svneol=native#text/plain
-compiler/compiler/bsdcompile -text
-compiler/compiler/catch.pas svneol=native#text/plain
-compiler/compiler/cclasses.pas svneol=native#text/plain
-compiler/compiler/cg64f32.pas svneol=native#text/plain
-compiler/compiler/cgbase.pas svneol=native#text/plain
-compiler/compiler/cgobj.pas svneol=native#text/plain
-compiler/compiler/cgutils.pas svneol=native#text/plain
-compiler/compiler/charset.pas svneol=native#text/plain
-compiler/compiler/cmsgs.pas svneol=native#text/plain
-compiler/compiler/comphook.pas svneol=native#text/plain
-compiler/compiler/compiler.pas svneol=native#text/plain
-compiler/compiler/compinnr.inc svneol=native#text/plain
-compiler/compiler/comprsrc.pas svneol=native#text/plain
-compiler/compiler/cp437.pas svneol=native#text/plain
-compiler/compiler/cp850.pas svneol=native#text/plain
-compiler/compiler/cp8859_1.pas svneol=native#text/plain
-compiler/compiler/crc.pas svneol=native#text/plain
-compiler/compiler/cresstr.pas svneol=native#text/plain
-compiler/compiler/cstreams.pas svneol=native#text/plain
-compiler/compiler/cutils.pas svneol=native#text/plain
-compiler/compiler/dbgbase.pas svneol=native#text/plain
-compiler/compiler/dbgdwarf.pas svneol=native#text/plain
-compiler/compiler/dbgstabs.pas svneol=native#text/plain
-compiler/compiler/defcmp.pas svneol=native#text/plain
-compiler/compiler/defutil.pas svneol=native#text/plain
-compiler/compiler/dwarf.pas svneol=native#text/plain
-compiler/compiler/export.pas svneol=native#text/plain
-compiler/compiler/finput.pas svneol=native#text/plain
-compiler/compiler/fmodule.pas svneol=native#text/plain
-compiler/compiler/fpcdefs.inc svneol=native#text/plain
-compiler/compiler/fppu.pas svneol=native#text/plain
-compiler/compiler/gendef.pas svneol=native#text/plain
-compiler/compiler/globals.pas svneol=native#text/plain
-compiler/compiler/globtype.pas svneol=native#text/plain
-compiler/compiler/html/i386/readme.txt svneol=native#text/plain
-compiler/compiler/html/powerpc/readme.txt svneol=native#text/plain
-compiler/compiler/htypechk.pas svneol=native#text/plain
-compiler/compiler/i386/ag386nsm.pas svneol=native#text/plain
-compiler/compiler/i386/aopt386.pas svneol=native#text/plain
-compiler/compiler/i386/cgcpu.pas svneol=native#text/plain
-compiler/compiler/i386/cpubase.inc svneol=native#text/plain
-compiler/compiler/i386/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/i386/cpunode.pas svneol=native#text/plain
-compiler/compiler/i386/cpupara.pas svneol=native#text/plain
-compiler/compiler/i386/cpupi.pas svneol=native#text/plain
-compiler/compiler/i386/cpuswtch.pas svneol=native#text/plain
-compiler/compiler/i386/cputarg.pas svneol=native#text/plain
-compiler/compiler/i386/csopt386.pas svneol=native#text/plain
-compiler/compiler/i386/daopt386.pas svneol=native#text/plain
-compiler/compiler/i386/i386att.inc svneol=native#text/plain
-compiler/compiler/i386/i386atts.inc svneol=native#text/plain
-compiler/compiler/i386/i386int.inc svneol=native#text/plain
-compiler/compiler/i386/i386nop.inc svneol=native#text/plain
-compiler/compiler/i386/i386op.inc svneol=native#text/plain
-compiler/compiler/i386/i386prop.inc svneol=native#text/plain
-compiler/compiler/i386/i386tab.inc svneol=native#text/plain
-compiler/compiler/i386/n386add.pas svneol=native#text/plain
-compiler/compiler/i386/n386cal.pas svneol=native#text/plain
-compiler/compiler/i386/n386inl.pas svneol=native#text/plain
-compiler/compiler/i386/n386mat.pas svneol=native#text/plain
-compiler/compiler/i386/n386mem.pas svneol=native#text/plain
-compiler/compiler/i386/n386set.pas svneol=native#text/plain
-compiler/compiler/i386/optbase.pas svneol=native#text/plain
-compiler/compiler/i386/popt386.pas svneol=native#text/plain
-compiler/compiler/i386/r386ari.inc svneol=native#text/plain
-compiler/compiler/i386/r386att.inc svneol=native#text/plain
-compiler/compiler/i386/r386con.inc svneol=native#text/plain
-compiler/compiler/i386/r386dwrf.inc svneol=native#text/plain
-compiler/compiler/i386/r386int.inc svneol=native#text/plain
-compiler/compiler/i386/r386iri.inc svneol=native#text/plain
-compiler/compiler/i386/r386nasm.inc svneol=native#text/plain
-compiler/compiler/i386/r386nor.inc svneol=native#text/plain
-compiler/compiler/i386/r386nri.inc svneol=native#text/plain
-compiler/compiler/i386/r386num.inc svneol=native#text/plain
-compiler/compiler/i386/r386op.inc svneol=native#text/plain
-compiler/compiler/i386/r386ot.inc svneol=native#text/plain
-compiler/compiler/i386/r386rni.inc svneol=native#text/plain
-compiler/compiler/i386/r386sri.inc svneol=native#text/plain
-compiler/compiler/i386/r386stab.inc svneol=native#text/plain
-compiler/compiler/i386/r386std.inc svneol=native#text/plain
-compiler/compiler/i386/ra386att.pas svneol=native#text/plain
-compiler/compiler/i386/ra386int.pas svneol=native#text/plain
-compiler/compiler/i386/rgcpu.pas svneol=native#text/plain
-compiler/compiler/i386/rropt386.pas svneol=native#text/plain
-compiler/compiler/ia64/cpuasm.pas svneol=native#text/plain
-compiler/compiler/ia64/cpubase.pas svneol=native#text/plain
-compiler/compiler/ia64/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/impdef.pas svneol=native#text/plain
-compiler/compiler/import.pas svneol=native#text/plain
-compiler/compiler/link.pas svneol=native#text/plain
-compiler/compiler/m68k/aasmcpu.pas svneol=native#text/plain
-compiler/compiler/m68k/agcpugas.pas svneol=native#text/plain
-compiler/compiler/m68k/aoptcpu.pas svneol=native#text/plain
-compiler/compiler/m68k/aoptcpub.pas svneol=native#text/plain
-compiler/compiler/m68k/aoptcpud.pas svneol=native#text/plain
-compiler/compiler/m68k/cgcpu.pas svneol=native#text/plain
-compiler/compiler/m68k/cpuasm.pas svneol=native#text/plain
-compiler/compiler/m68k/cpubase.pas svneol=native#text/plain
-compiler/compiler/m68k/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/m68k/cpunode.pas svneol=native#text/plain
-compiler/compiler/m68k/cpupara.pas svneol=native#text/plain
-compiler/compiler/m68k/cpupi.pas svneol=native#text/plain
-compiler/compiler/m68k/cpuswtch.pas svneol=native#text/plain
-compiler/compiler/m68k/cputarg.pas svneol=native#text/plain
-compiler/compiler/m68k/itcpugas.pas svneol=native#text/plain
-compiler/compiler/m68k/n68kcnv.pas svneol=native#text/plain
-compiler/compiler/m68k/n68kmat.pas svneol=native#text/plain
-compiler/compiler/m68k/ncpuadd.pas svneol=native#text/plain
-compiler/compiler/m68k/r68kcon.inc svneol=native#text/plain
-compiler/compiler/m68k/r68kgas.inc svneol=native#text/plain
-compiler/compiler/m68k/r68kgri.inc svneol=native#text/plain
-compiler/compiler/m68k/r68knor.inc svneol=native#text/plain
-compiler/compiler/m68k/r68knum.inc svneol=native#text/plain
-compiler/compiler/m68k/r68krni.inc svneol=native#text/plain
-compiler/compiler/m68k/r68ksri.inc svneol=native#text/plain
-compiler/compiler/m68k/r68ksta.inc svneol=native#text/plain
-compiler/compiler/m68k/r68kstd.inc svneol=native#text/plain
-compiler/compiler/m68k/r68ksup.inc svneol=native#text/plain
-compiler/compiler/m68k/ra68k.pas svneol=native#text/plain
-compiler/compiler/m68k/ra68kmot.pas svneol=native#text/plain
-compiler/compiler/m68k/rgcpu.pas svneol=native#text/plain
-compiler/compiler/make_old.cmd -text
-compiler/compiler/mdppc386.bat -text
-compiler/compiler/mips/aasmcpu.pas svneol=native#text/plain
-compiler/compiler/mips/cpubase.pas svneol=native#text/plain
-compiler/compiler/mips/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/mips/itcpugas.pas svneol=native#text/plain
-compiler/compiler/mips/rmipscon.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsdwf.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsgas.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsgri.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsgss.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsmot.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsmri.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsnor.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsnum.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsrni.inc svneol=native#text/plain
-compiler/compiler/mips/rmipssri.inc svneol=native#text/plain
-compiler/compiler/mips/rmipssta.inc svneol=native#text/plain
-compiler/compiler/mips/rmipsstd.inc svneol=native#text/plain
-compiler/compiler/mips/rmipssup.inc svneol=native#text/plain
-compiler/compiler/mppc386.bat -text
-compiler/compiler/mppc68k.bat -text
-compiler/compiler/mppcsparc -text
-compiler/compiler/msg/errorct.msg svneol=native#text/plain
-compiler/compiler/msg/errord.msg svneol=native#text/plain
-compiler/compiler/msg/errore.msg svneol=native#text/plain
-compiler/compiler/msg/errores.msg svneol=native#text/plain
-compiler/compiler/msg/errorf.msg svneol=native#text/plain
-compiler/compiler/msg/errorhe.msg svneol=native#text/plain
-compiler/compiler/msg/errorn.msg svneol=native#text/plain
-compiler/compiler/msg/errorpl.msg svneol=native#text/plain
-compiler/compiler/msg/errorpli.msg svneol=native#text/plain
-compiler/compiler/msg/errorptd.msg -text
-compiler/compiler/msg/errorptw.msg -text
-compiler/compiler/msg/errorr.msg svneol=native#text/plain
-compiler/compiler/msg/errorrw.msg svneol=native#text/plain
-compiler/compiler/msg/errorues.msg svneol=native#text/plain
-compiler/compiler/msgidx.inc svneol=native#text/plain
-compiler/compiler/msgtxt.inc svneol=native#text/plain
-compiler/compiler/nadd.pas svneol=native#text/plain
-compiler/compiler/nbas.pas svneol=native#text/plain
-compiler/compiler/ncal.pas svneol=native#text/plain
-compiler/compiler/ncgadd.pas svneol=native#text/plain
-compiler/compiler/ncgbas.pas svneol=native#text/plain
-compiler/compiler/ncgcal.pas svneol=native#text/plain
-compiler/compiler/ncgcnv.pas svneol=native#text/plain
-compiler/compiler/ncgcon.pas svneol=native#text/plain
-compiler/compiler/ncgflw.pas svneol=native#text/plain
-compiler/compiler/ncginl.pas svneol=native#text/plain
-compiler/compiler/ncgld.pas svneol=native#text/plain
-compiler/compiler/ncgmat.pas svneol=native#text/plain
-compiler/compiler/ncgmem.pas svneol=native#text/plain
-compiler/compiler/ncgopt.pas svneol=native#text/plain
-compiler/compiler/ncgset.pas svneol=native#text/plain
-compiler/compiler/ncgutil.pas svneol=native#text/plain
-compiler/compiler/ncnv.pas svneol=native#text/plain
-compiler/compiler/ncon.pas svneol=native#text/plain
-compiler/compiler/nflw.pas svneol=native#text/plain
-compiler/compiler/ninl.pas svneol=native#text/plain
-compiler/compiler/nld.pas svneol=native#text/plain
-compiler/compiler/nmat.pas svneol=native#text/plain
-compiler/compiler/nmem.pas svneol=native#text/plain
-compiler/compiler/nobj.pas svneol=native#text/plain
-compiler/compiler/node.pas svneol=native#text/plain
-compiler/compiler/nopt.pas svneol=native#text/plain
-compiler/compiler/nset.pas svneol=native#text/plain
-compiler/compiler/nstate.pas svneol=native#text/plain
-compiler/compiler/nutils.pas svneol=native#text/plain
-compiler/compiler/ogbase.pas svneol=native#text/plain
-compiler/compiler/ogcoff.pas svneol=native#text/plain
-compiler/compiler/ogelf.pas svneol=native#text/plain
-compiler/compiler/oglx.pas svneol=native#text/plain
-compiler/compiler/ogmap.pas svneol=native#text/plain
-compiler/compiler/optcse.pas svneol=native#text/plain
-compiler/compiler/options.pas svneol=native#text/plain
-compiler/compiler/optunrol.pas svneol=native#text/plain
-compiler/compiler/owar.pas svneol=native#text/plain
-compiler/compiler/owbase.pas svneol=native#text/plain
-compiler/compiler/parabase.pas svneol=native#text/plain
-compiler/compiler/paramgr.pas svneol=native#text/plain
-compiler/compiler/parser.pas svneol=native#text/plain
-compiler/compiler/pass_1.pas svneol=native#text/plain
-compiler/compiler/pass_2.pas svneol=native#text/plain
-compiler/compiler/pbase.pas svneol=native#text/plain
-compiler/compiler/pdecl.pas svneol=native#text/plain
-compiler/compiler/pdecobj.pas svneol=native#text/plain
-compiler/compiler/pdecsub.pas svneol=native#text/plain
-compiler/compiler/pdecvar.pas svneol=native#text/plain
-compiler/compiler/pexports.pas svneol=native#text/plain
-compiler/compiler/pexpr.pas svneol=native#text/plain
-compiler/compiler/pinline.pas svneol=native#text/plain
-compiler/compiler/pmodules.pas svneol=native#text/plain
-compiler/compiler/powerpc/aasmcpu.pas svneol=native#text/plain
-compiler/compiler/powerpc/agppcgas.pas svneol=native#text/plain
-compiler/compiler/powerpc/agppcmpw.pas svneol=native#text/plain
-compiler/compiler/powerpc/aoptcpu.pas svneol=native#text/plain
-compiler/compiler/powerpc/aoptcpub.pas svneol=native#text/plain
-compiler/compiler/powerpc/aoptcpuc.pas svneol=native#text/plain
-compiler/compiler/powerpc/aoptcpud.pas svneol=native#text/plain
-compiler/compiler/powerpc/cgcpu.pas svneol=native#text/plain
-compiler/compiler/powerpc/cpubase.pas svneol=native#text/plain
-compiler/compiler/powerpc/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/powerpc/cpunode.pas svneol=native#text/plain
-compiler/compiler/powerpc/cpupara.pas svneol=native#text/plain
-compiler/compiler/powerpc/cpupi.pas svneol=native#text/plain
-compiler/compiler/powerpc/cpuswtch.pas svneol=native#text/plain
-compiler/compiler/powerpc/cputarg.pas svneol=native#text/plain
-compiler/compiler/powerpc/itcpugas.pas svneol=native#text/plain
-compiler/compiler/powerpc/nppcadd.pas svneol=native#text/plain
-compiler/compiler/powerpc/nppccal.pas svneol=native#text/plain
-compiler/compiler/powerpc/nppccnv.pas svneol=native#text/plain
-compiler/compiler/powerpc/nppcinl.pas svneol=native#text/plain
-compiler/compiler/powerpc/nppcld.pas svneol=native#text/plain
-compiler/compiler/powerpc/nppcmat.pas svneol=native#text/plain
-compiler/compiler/powerpc/nppcset.pas svneol=native#text/plain
-compiler/compiler/powerpc/rappc.pas svneol=native#text/plain
-compiler/compiler/powerpc/rappcgas.pas svneol=native#text/plain
-compiler/compiler/powerpc/rgcpu.pas svneol=native#text/plain
-compiler/compiler/powerpc/rppccon.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcdwrf.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcgas.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcgri.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcgss.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcmot.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcmri.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcnor.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcnum.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcrni.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcsri.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcstab.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcstd.inc svneol=native#text/plain
-compiler/compiler/powerpc/rppcsup.inc svneol=native#text/plain
-compiler/compiler/powerpc64/aasmcpu.pas svneol=native#text/plain
-compiler/compiler/powerpc64/agppcgas.pas svneol=native#text/plain
-compiler/compiler/powerpc64/aoptcpu.pas svneol=native#text/plain
-compiler/compiler/powerpc64/aoptcpub.pas svneol=native#text/plain
-compiler/compiler/powerpc64/aoptcpuc.pas svneol=native#text/plain
-compiler/compiler/powerpc64/aoptcpud.pas svneol=native#text/plain
-compiler/compiler/powerpc64/cgcpu.pas svneol=native#text/plain
-compiler/compiler/powerpc64/cpubase.pas svneol=native#text/plain
-compiler/compiler/powerpc64/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/powerpc64/cpunode.pas svneol=native#text/plain
-compiler/compiler/powerpc64/cpupara.pas svneol=native#text/plain
-compiler/compiler/powerpc64/cpupi.pas svneol=native#text/plain
-compiler/compiler/powerpc64/cpuswtch.pas svneol=native#text/plain
-compiler/compiler/powerpc64/cputarg.pas svneol=native#text/plain
-compiler/compiler/powerpc64/itcpugas.pas svneol=native#text/plain
-compiler/compiler/powerpc64/nppcadd.pas svneol=native#text/plain
-compiler/compiler/powerpc64/nppccal.pas svneol=native#text/plain
-compiler/compiler/powerpc64/nppccnv.pas svneol=native#text/plain
-compiler/compiler/powerpc64/nppcinl.pas svneol=native#text/plain
-compiler/compiler/powerpc64/nppcld.pas svneol=native#text/plain
-compiler/compiler/powerpc64/nppcmat.pas svneol=native#text/plain
-compiler/compiler/powerpc64/nppcset.pas svneol=native#text/plain
-compiler/compiler/powerpc64/ppcins.dat -text
-compiler/compiler/powerpc64/ppcreg.dat -text
-compiler/compiler/powerpc64/rappc.pas svneol=native#text/plain
-compiler/compiler/powerpc64/rappcgas.pas svneol=native#text/plain
-compiler/compiler/powerpc64/rgcpu.pas svneol=native#text/plain
-compiler/compiler/powerpc64/rppccon.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcdwrf.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcgas.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcgri.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcgss.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcmot.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcmri.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcnor.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcnum.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcrni.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcsri.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcstab.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcstd.inc svneol=native#text/plain
-compiler/compiler/powerpc64/rppcsup.inc svneol=native#text/plain
-compiler/compiler/pp.lpi -text
-compiler/compiler/pp.pas svneol=native#text/plain
-compiler/compiler/ppc.cfg -text
-compiler/compiler/ppc.conf -text
-compiler/compiler/ppc.dof -text
-compiler/compiler/ppc.dpr -text
-compiler/compiler/ppheap.pas svneol=native#text/plain
-compiler/compiler/ppu.pas svneol=native#text/plain
-compiler/compiler/procinfo.pas svneol=native#text/plain
-compiler/compiler/pstatmnt.pas svneol=native#text/plain
-compiler/compiler/psub.pas svneol=native#text/plain
-compiler/compiler/psystem.pas svneol=native#text/plain
-compiler/compiler/ptconst.pas svneol=native#text/plain
-compiler/compiler/ptype.pas svneol=native#text/plain
-compiler/compiler/raatt.pas svneol=native#text/plain
-compiler/compiler/rabase.pas svneol=native#text/plain
-compiler/compiler/rasm.pas svneol=native#text/plain
-compiler/compiler/rautils.pas svneol=native#text/plain
-compiler/compiler/regvars.pas svneol=native#text/plain
-compiler/compiler/rgbase.pas svneol=native#text/plain
-compiler/compiler/rgobj.pas svneol=native#text/plain
-compiler/compiler/scandir.pas svneol=native#text/plain
-compiler/compiler/scanner.pas svneol=native#text/plain
-compiler/compiler/script.pas svneol=native#text/plain
-compiler/compiler/sparc/aasmcpu.pas svneol=native#text/plain
-compiler/compiler/sparc/aoptcpu.pas svneol=native#text/plain
-compiler/compiler/sparc/aoptcpub.pas svneol=native#text/plain
-compiler/compiler/sparc/aoptcpud.pas svneol=native#text/plain
-compiler/compiler/sparc/cgcpu.pas svneol=native#text/plain
-compiler/compiler/sparc/cpubase.pas svneol=native#text/plain
-compiler/compiler/sparc/cpugas.pas svneol=native#text/plain
-compiler/compiler/sparc/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/sparc/cpunode.pas svneol=native#text/plain
-compiler/compiler/sparc/cpupara.pas svneol=native#text/plain
-compiler/compiler/sparc/cpupi.pas svneol=native#text/plain
-compiler/compiler/sparc/cpuswtch.pas svneol=native#text/plain
-compiler/compiler/sparc/cputarg.pas svneol=native#text/plain
-compiler/compiler/sparc/itcpugas.pas svneol=native#text/plain
-compiler/compiler/sparc/ncpuadd.pas svneol=native#text/plain
-compiler/compiler/sparc/ncpucall.pas svneol=native#text/plain
-compiler/compiler/sparc/ncpucnv.pas svneol=native#text/plain
-compiler/compiler/sparc/ncpuinln.pas svneol=native#text/plain
-compiler/compiler/sparc/ncpumat.pas svneol=native#text/plain
-compiler/compiler/sparc/ncpuset.pas svneol=native#text/plain
-compiler/compiler/sparc/opcode.inc svneol=native#text/plain
-compiler/compiler/sparc/racpu.pas svneol=native#text/plain
-compiler/compiler/sparc/racpugas.pas svneol=native#text/plain
-compiler/compiler/sparc/rgcpu.pas svneol=native#text/plain
-compiler/compiler/sparc/rspcon.inc svneol=native#text/plain
-compiler/compiler/sparc/rspdwrf.inc svneol=native#text/plain
-compiler/compiler/sparc/rspnor.inc svneol=native#text/plain
-compiler/compiler/sparc/rspnum.inc svneol=native#text/plain
-compiler/compiler/sparc/rsprni.inc svneol=native#text/plain
-compiler/compiler/sparc/rspsri.inc svneol=native#text/plain
-compiler/compiler/sparc/rspstab.inc svneol=native#text/plain
-compiler/compiler/sparc/rspstd.inc svneol=native#text/plain
-compiler/compiler/sparc/rspsup.inc svneol=native#text/plain
-compiler/compiler/sparc/strinst.inc svneol=native#text/plain
-compiler/compiler/switches.pas svneol=native#text/plain
-compiler/compiler/symbase.pas svneol=native#text/plain
-compiler/compiler/symconst.pas svneol=native#text/plain
-compiler/compiler/symdef.pas svneol=native#text/plain
-compiler/compiler/symnot.pas svneol=native#text/plain
-compiler/compiler/symsym.pas svneol=native#text/plain
-compiler/compiler/symtable.pas svneol=native#text/plain
-compiler/compiler/symtype.pas svneol=native#text/plain
-compiler/compiler/symutil.pas svneol=native#text/plain
-compiler/compiler/systems.pas svneol=native#text/plain
-compiler/compiler/systems/i_amiga.pas svneol=native#text/plain
-compiler/compiler/systems/i_atari.pas svneol=native#text/plain
-compiler/compiler/systems/i_beos.pas svneol=native#text/plain
-compiler/compiler/systems/i_bsd.pas svneol=native#text/plain
-compiler/compiler/systems/i_emx.pas svneol=native#text/plain
-compiler/compiler/systems/i_gba.pas svneol=native#text/plain
-compiler/compiler/systems/i_go32v2.pas svneol=native#text/plain
-compiler/compiler/systems/i_linux.pas svneol=native#text/plain
-compiler/compiler/systems/i_macos.pas svneol=native#text/plain
-compiler/compiler/systems/i_morph.pas svneol=native#text/plain
-compiler/compiler/systems/i_nwl.pas svneol=native#text/plain
-compiler/compiler/systems/i_nwm.pas svneol=native#text/plain
-compiler/compiler/systems/i_os2.pas svneol=native#text/plain
-compiler/compiler/systems/i_palmos.pas svneol=native#text/plain
-compiler/compiler/systems/i_sunos.pas svneol=native#text/plain
-compiler/compiler/systems/i_watcom.pas svneol=native#text/plain
-compiler/compiler/systems/i_wdosx.pas svneol=native#text/plain
-compiler/compiler/systems/i_win.pas svneol=native#text/plain
-compiler/compiler/systems/mac_crea.txt svneol=native#text/plain
-compiler/compiler/systems/t_amiga.pas svneol=native#text/plain
-compiler/compiler/systems/t_atari.pas svneol=native#text/plain
-compiler/compiler/systems/t_beos.pas svneol=native#text/plain
-compiler/compiler/systems/t_bsd.pas svneol=native#text/plain
-compiler/compiler/systems/t_emx.pas svneol=native#text/plain
-compiler/compiler/systems/t_gba.pas svneol=native#text/plain
-compiler/compiler/systems/t_go32v2.pas svneol=native#text/plain
-compiler/compiler/systems/t_linux.pas svneol=native#text/plain
-compiler/compiler/systems/t_macos.pas svneol=native#text/plain
-compiler/compiler/systems/t_morph.pas svneol=native#text/plain
-compiler/compiler/systems/t_nwl.pas svneol=native#text/plain
-compiler/compiler/systems/t_nwm.pas svneol=native#text/plain
-compiler/compiler/systems/t_os2.pas svneol=native#text/plain
-compiler/compiler/systems/t_palmos.pas svneol=native#text/plain
-compiler/compiler/systems/t_sunos.pas svneol=native#text/plain
-compiler/compiler/systems/t_watcom.pas svneol=native#text/plain
-compiler/compiler/systems/t_wdosx.pas svneol=native#text/plain
-compiler/compiler/systems/t_win.pas svneol=native#text/plain
-compiler/compiler/tgobj.pas svneol=native#text/plain
-compiler/compiler/tokens.pas svneol=native#text/plain
-compiler/compiler/utils/Makefile svneol=native#text/plain
-compiler/compiler/utils/Makefile.fpc svneol=native#text/plain
-compiler/compiler/utils/README -text
-compiler/compiler/utils/fixlog.pp svneol=native#text/plain
-compiler/compiler/utils/fixmsg.pp svneol=native#text/plain
-compiler/compiler/utils/fixnasm.pp svneol=native#text/plain
-compiler/compiler/utils/fixtab.pp svneol=native#text/plain
-compiler/compiler/utils/fpc.cft svneol=native#text/plain
-compiler/compiler/utils/fpc.mpw -text
-compiler/compiler/utils/fpc.pp svneol=native#text/plain
-compiler/compiler/utils/fpccfg.inc svneol=native#text/plain
-compiler/compiler/utils/fpcmkcfg.pp svneol=native#text/plain
-compiler/compiler/utils/fpcsubst.pp svneol=native#text/plain
-compiler/compiler/utils/fpimpdef.pp svneol=native#text/plain
-compiler/compiler/utils/fppkg.pp svneol=native#text/plain
-compiler/compiler/utils/gppc386.pp svneol=native#text/plain
-compiler/compiler/utils/mk68kreg.pp svneol=native#text/plain
-compiler/compiler/utils/mkarmins.pp svneol=native#text/plain
-compiler/compiler/utils/mkarmreg.pp svneol=native#text/plain
-compiler/compiler/utils/mkmpsreg.pp svneol=native#text/plain
-compiler/compiler/utils/mkppcreg.pp svneol=native#text/plain
-compiler/compiler/utils/mkspreg.pp svneol=native#text/plain
-compiler/compiler/utils/mkx86ins.pp svneol=native#text/plain
-compiler/compiler/utils/mkx86reg.pp svneol=native#text/plain
-compiler/compiler/utils/msg2inc.pp svneol=native#text/plain
-compiler/compiler/utils/msgdif.pp svneol=native#text/plain
-compiler/compiler/utils/msgused.pl -text
-compiler/compiler/utils/ppudump.pp svneol=native#text/plain
-compiler/compiler/utils/ppufiles.pp svneol=native#text/plain
-compiler/compiler/utils/ppumove.pp svneol=native#text/plain
-compiler/compiler/utils/samplecfg -text
-compiler/compiler/utils/usubst.pp svneol=native#text/plain
-compiler/compiler/verbose.pas svneol=native#text/plain
-compiler/compiler/version.pas svneol=native#text/plain
-compiler/compiler/vis/aasmcpu.pas svneol=native#text/plain
-compiler/compiler/vis/cpubase.pas svneol=native#text/plain
-compiler/compiler/vis/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/vis/cpunode.pas svneol=native#text/plain
-compiler/compiler/vis/cpupara.pas svneol=native#text/plain
-compiler/compiler/widestr.pas svneol=native#text/plain
-compiler/compiler/x86/aasmcpu.pas svneol=native#text/plain
-compiler/compiler/x86/agx86att.pas svneol=native#text/plain
-compiler/compiler/x86/agx86int.pas svneol=native#text/plain
-compiler/compiler/x86/cga.pas svneol=native#text/plain
-compiler/compiler/x86/cgx86.pas svneol=native#text/plain
-compiler/compiler/x86/cpubase.pas svneol=native#text/plain
-compiler/compiler/x86/itcpugas.pas svneol=native#text/plain
-compiler/compiler/x86/itx86int.pas svneol=native#text/plain
-compiler/compiler/x86/nx86add.pas svneol=native#text/plain
-compiler/compiler/x86/nx86cnv.pas svneol=native#text/plain
-compiler/compiler/x86/nx86con.pas svneol=native#text/plain
-compiler/compiler/x86/nx86inl.pas svneol=native#text/plain
-compiler/compiler/x86/nx86mat.pas svneol=native#text/plain
-compiler/compiler/x86/nx86set.pas svneol=native#text/plain
-compiler/compiler/x86/rax86.pas svneol=native#text/plain
-compiler/compiler/x86/rax86att.pas svneol=native#text/plain
-compiler/compiler/x86/rgx86.pas svneol=native#text/plain
-compiler/compiler/x86_64/aoptcpu.pas svneol=native#text/plain
-compiler/compiler/x86_64/aoptcpub.pas svneol=native#text/plain
-compiler/compiler/x86_64/aoptcpud.pas svneol=native#text/plain
-compiler/compiler/x86_64/cgcpu.pas svneol=native#text/plain
-compiler/compiler/x86_64/cpubase.inc svneol=native#text/plain
-compiler/compiler/x86_64/cpuinfo.pas svneol=native#text/plain
-compiler/compiler/x86_64/cpunode.pas svneol=native#text/plain
-compiler/compiler/x86_64/cpupara.pas svneol=native#text/plain
-compiler/compiler/x86_64/cpupi.pas svneol=native#text/plain
-compiler/compiler/x86_64/cpuswtch.pas svneol=native#text/plain
-compiler/compiler/x86_64/cputarg.pas svneol=native#text/plain
-compiler/compiler/x86_64/nx64add.pas svneol=native#text/plain
-compiler/compiler/x86_64/nx64cal.pas svneol=native#text/plain
-compiler/compiler/x86_64/nx64cnv.pas svneol=native#text/plain
-compiler/compiler/x86_64/nx64inl.pas svneol=native#text/plain
-compiler/compiler/x86_64/nx64mat.pas svneol=native#text/plain
-compiler/compiler/x86_64/r8664ari.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664att.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664con.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664dwrf.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664int.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664iri.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664nor.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664num.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664op.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664ot.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664rni.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664sri.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664stab.inc svneol=native#text/plain
-compiler/compiler/x86_64/r8664std.inc svneol=native#text/plain
-compiler/compiler/x86_64/rax64att.pas svneol=native#text/plain
-compiler/compiler/x86_64/rgcpu.pas svneol=native#text/plain
-compiler/compiler/x86_64/x8664ats.inc svneol=native#text/plain
-compiler/compiler/x86_64/x8664att.inc svneol=native#text/plain
-compiler/compiler/x86_64/x8664int.inc svneol=native#text/plain
-compiler/compiler/x86_64/x8664nop.inc svneol=native#text/plain
-compiler/compiler/x86_64/x8664op.inc svneol=native#text/plain
-compiler/compiler/x86_64/x8664pro.inc svneol=native#text/plain
-compiler/compiler/x86_64/x8664tab.inc svneol=native#text/plain
 compiler/compinnr.inc svneol=native#text/plain
 compiler/comprsrc.pas svneol=native#text/plain
 compiler/cp437.pas svneol=native#text/plain

.gitignore

@@ -1,131 +1,5 @@
 compiler/*.bak
 compiler/*.exe
-compiler/compiler/*.bak
-compiler/compiler/*.exe
-compiler/compiler/*.o
-compiler/compiler/*.ppu
-compiler/compiler/*.s
-compiler/compiler/alpha/*.bak
-compiler/compiler/alpha/*.exe
-compiler/compiler/alpha/*.o
-compiler/compiler/alpha/*.ppu
-compiler/compiler/alpha/*.s
-compiler/compiler/alpha/fpcmade.*
-compiler/compiler/alpha/units
-compiler/compiler/arm/*.bak
-compiler/compiler/arm/*.exe
-compiler/compiler/arm/*.o
-compiler/compiler/arm/*.ppu
-compiler/compiler/arm/*.s
-compiler/compiler/arm/fpcmade.*
-compiler/compiler/arm/units
-compiler/compiler/fpcmade.*
-compiler/compiler/html/*.bak
-compiler/compiler/html/*.exe
-compiler/compiler/html/*.o
-compiler/compiler/html/*.ppu
-compiler/compiler/html/*.s
-compiler/compiler/html/fpcmade.*
-compiler/compiler/html/i386/*.bak
-compiler/compiler/html/i386/*.exe
-compiler/compiler/html/i386/*.o
-compiler/compiler/html/i386/*.ppu
-compiler/compiler/html/i386/*.s
-compiler/compiler/html/i386/fpcmade.*
-compiler/compiler/html/i386/units
-compiler/compiler/html/powerpc/*.bak
-compiler/compiler/html/powerpc/*.exe
-compiler/compiler/html/powerpc/*.o
-compiler/compiler/html/powerpc/*.ppu
-compiler/compiler/html/powerpc/*.s
-compiler/compiler/html/powerpc/fpcmade.*
-compiler/compiler/html/powerpc/units
-compiler/compiler/html/units
-compiler/compiler/i386/*.bak
-compiler/compiler/i386/*.exe
-compiler/compiler/i386/*.o
-compiler/compiler/i386/*.ppu
-compiler/compiler/i386/*.s
-compiler/compiler/i386/fpcmade.*
-compiler/compiler/i386/units
-compiler/compiler/ia64/*.bak
-compiler/compiler/ia64/*.exe
-compiler/compiler/ia64/*.o
-compiler/compiler/ia64/*.ppu
-compiler/compiler/ia64/*.s
-compiler/compiler/ia64/fpcmade.*
-compiler/compiler/ia64/units
-compiler/compiler/m68k/*.bak
-compiler/compiler/m68k/*.exe
-compiler/compiler/m68k/*.o
-compiler/compiler/m68k/*.ppu
-compiler/compiler/m68k/*.s
-compiler/compiler/m68k/fpcmade.*
-compiler/compiler/m68k/units
-compiler/compiler/mips/*.bak
-compiler/compiler/mips/*.exe
-compiler/compiler/mips/*.o
-compiler/compiler/mips/*.ppu
-compiler/compiler/mips/*.s
-compiler/compiler/mips/fpcmade.*
-compiler/compiler/mips/units
-compiler/compiler/msg/*.bak
-compiler/compiler/msg/*.exe
-compiler/compiler/msg/*.o
-compiler/compiler/msg/*.ppu
-compiler/compiler/msg/*.s
-compiler/compiler/msg/fpcmade.*
-compiler/compiler/msg/units
-compiler/compiler/powerpc/*.bak
-compiler/compiler/powerpc/*.exe
-compiler/compiler/powerpc/*.o
-compiler/compiler/powerpc/*.ppu
-compiler/compiler/powerpc/*.s
-compiler/compiler/powerpc/fpcmade.*
-compiler/compiler/powerpc/units
-compiler/compiler/sparc/*.bak
-compiler/compiler/sparc/*.exe
-compiler/compiler/sparc/*.o
-compiler/compiler/sparc/*.ppu
-compiler/compiler/sparc/*.s
-compiler/compiler/sparc/fpcmade.*
-compiler/compiler/sparc/units
-compiler/compiler/systems/*.bak
-compiler/compiler/systems/*.exe
-compiler/compiler/systems/*.o
-compiler/compiler/systems/*.ppu
-compiler/compiler/systems/*.s
-compiler/compiler/systems/fpcmade.*
-compiler/compiler/systems/units
-compiler/compiler/units
-compiler/compiler/utils/*.bak
-compiler/compiler/utils/*.exe
-compiler/compiler/utils/*.o
-compiler/compiler/utils/*.ppu
-compiler/compiler/utils/*.s
-compiler/compiler/utils/fpcmade.*
-compiler/compiler/utils/units
-compiler/compiler/vis/*.bak
-compiler/compiler/vis/*.exe
-compiler/compiler/vis/*.o
-compiler/compiler/vis/*.ppu
-compiler/compiler/vis/*.s
-compiler/compiler/vis/fpcmade.*
-compiler/compiler/vis/units
-compiler/compiler/x86/*.bak
-compiler/compiler/x86/*.exe
-compiler/compiler/x86/*.o
-compiler/compiler/x86/*.ppu
-compiler/compiler/x86/*.s
-compiler/compiler/x86/fpcmade.*
-compiler/compiler/x86/units
-compiler/compiler/x86_64/*.bak
-compiler/compiler/x86_64/*.exe
-compiler/compiler/x86_64/*.o
-compiler/compiler/x86_64/*.ppu
-compiler/compiler/x86_64/*.s
-compiler/compiler/x86_64/fpcmade.*
-compiler/compiler/x86_64/units
 compiler/i386/*.bak
 compiler/utils/*.exe
 compiler/x86/*.bak

compiler/compiler/COPYING

@@ -1,340 +0,0 @@
-		    GNU GENERAL PUBLIC LICENSE
-		       Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
-                       59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-			    Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users.  This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it.  (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.)  You can apply it to
-your programs, too.
-
-  When we speak of free software, we are referring to freedom, not
-price.  Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
-  To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
-  For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have.  You must make sure that they, too, receive or can get the
-source code.  And you must show them these terms so they know their
-rights.
-
-  We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
-  Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software.  If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
-  Finally, any free program is threatened constantly by software
-patents.  We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary.  To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.
-
-		    GNU GENERAL PUBLIC LICENSE
-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-  0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License.  The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language.  (Hereinafter, translation is included without limitation in
-the term "modification".)  Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope.  The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
-  1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
-  2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
-    a) You must cause the modified files to carry prominent notices
-    stating that you changed the files and the date of any change.
-
-    b) You must cause any work that you distribute or publish, that in
-    whole or in part contains or is derived from the Program or any
-    part thereof, to be licensed as a whole at no charge to all third
-    parties under the terms of this License.
-
-    c) If the modified program normally reads commands interactively
-    when run, you must cause it, when started running for such
-    interactive use in the most ordinary way, to print or display an
-    announcement including an appropriate copyright notice and a
-    notice that there is no warranty (or else, saying that you provide
-    a warranty) and that users may redistribute the program under
-    these conditions, and telling the user how to view a copy of this
-    License.  (Exception: if the Program itself is interactive but
-    does not normally print such an announcement, your work based on
-    the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole.  If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works.  But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
-  3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
-    a) Accompany it with the complete corresponding machine-readable
-    source code, which must be distributed under the terms of Sections
-    1 and 2 above on a medium customarily used for software interchange; or,
-
-    b) Accompany it with a written offer, valid for at least three
-    years, to give any third party, for a charge no more than your
-    cost of physically performing source distribution, a complete
-    machine-readable copy of the corresponding source code, to be
-    distributed under the terms of Sections 1 and 2 above on a medium
-    customarily used for software interchange; or,
-
-    c) Accompany it with the information you received as to the offer
-    to distribute corresponding source code.  (This alternative is
-    allowed only for noncommercial distribution and only if you
-    received the program in object code or executable form with such
-    an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it.  For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable.  However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
-  4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License.  Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
-  5. You are not required to accept this License, since you have not
-signed it.  However, nothing else grants you permission to modify or
-distribute the Program or its derivative works.  These actions are
-prohibited by law if you do not accept this License.  Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
-  6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions.  You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
-  7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License.  If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all.  For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices.  Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
-  8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded.  In such case, this License incorporates
-the limitation as if written in the body of this License.
-
-  9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time.  Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number.  If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation.  If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
-  10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission.  For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this.  Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
-			    NO WARRANTY
-
-  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
-  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
-		     END OF TERMS AND CONDITIONS
-
-	    How to Apply These Terms to Your New Programs
-
-  If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
-  To do so, attach the following notices to the program.  It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
-    <one line to give the program's name and a brief idea of what it does.>
-    Copyright (C) <year>  <name of author>
-
-    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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
-    Gnomovision version 69, Copyright (C) year name of author
-    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
-    This is free software, and you are welcome to redistribute it
-    under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License.  Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary.  Here is a sample; alter the names:
-
-  Yoyodyne, Inc., hereby disclaims all copyright interest in the program
-  `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
-  <signature of Ty Coon>, 1 April 1989
-  Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs.  If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library.  If this is what you want to do, use the GNU Library General
-Public License instead of this License.

compiler/compiler/Makefile

@@ -1,2785 +0,0 @@
-#
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2005/10/20]
-#
-default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-wince powerpc64-linux
-BSDs = freebsd netbsd openbsd darwin
-UNIXs = linux $(BSDs) solaris qnx
-LIMIT83fs = go32v2 os2 emx watcom
-FORCE:
-.PHONY: FORCE
-override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
-ifneq ($(findstring darwin,$(OSTYPE)),)
-inUnix=1 #darwin
-SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
-else
-ifeq ($(findstring ;,$(PATH)),)
-inUnix=1
-SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
-else
-SEARCHPATH:=$(subst ;, ,$(PATH))
-endif
-endif
-SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
-ifeq ($(PWD),)
-$(error You need the GNU utils package to use this Makefile)
-else
-PWD:=$(firstword $(PWD))
-SRCEXEEXT=
-endif
-else
-PWD:=$(firstword $(PWD))
-SRCEXEEXT=.exe
-endif
-ifndef inUnix
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-else
-ifdef OS2_SHELL
-inOS2=1
-endif
-endif
-else
-ifneq ($(findstring cygdrive,$(PATH)),)
-inCygWin=1
-endif
-endif
-ifdef inUnix
-SRCBATCHEXT=.sh
-else
-ifdef inOS2
-SRCBATCHEXT=.cmd
-else
-SRCBATCHEXT=.bat
-endif
-endif
-ifdef inUnix
-PATHSEP=/
-else
-PATHSEP:=$(subst /,\,/)
-ifdef inCygWin
-PATHSEP=/
-endif
-endif
-ifdef PWD
-BASEDIR:=$(subst \,/,$(shell $(PWD)))
-ifdef inCygWin
-ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
-BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
-BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
-BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
-endif
-endif
-else
-BASEDIR=.
-endif
-ifdef inOS2
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO=echo
-else
-ECHO:=$(firstword $(ECHO))
-endif
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-endif
-override DEFAULT_FPCDIR=..
-ifndef FPC
-ifdef PP
-FPC=$(PP)
-endif
-endif
-ifndef FPC
-FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
-ifneq ($(FPCPROG),)
-FPCPROG:=$(firstword $(FPCPROG))
-FPC:=$(shell $(FPCPROG) -PB)
-ifneq ($(findstring Error,$(FPC)),)
-override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
-endif
-else
-override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
-endif
-endif
-override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
-override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
-FOUNDFPC:=$(strip $(wildcard $(FPC)))
-ifeq ($(FOUNDFPC),)
-FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
-ifeq ($(FOUNDFPC),)
-$(error Compiler $(FPC) not found)
-endif
-endif
-ifndef FPC_COMPILERINFO
-FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
-endif
-ifndef FPC_VERSION
-FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
-endif
-export FPC FPC_VERSION FPC_COMPILERINFO
-unexport CHECKDEPEND ALLDEPENDENCIES
-ifndef CPU_TARGET
-ifdef CPU_TARGET_DEFAULT
-CPU_TARGET=$(CPU_TARGET_DEFAULT)
-endif
-endif
-ifndef OS_TARGET
-ifdef OS_TARGET_DEFAULT
-OS_TARGET=$(OS_TARGET_DEFAULT)
-endif
-endif
-ifneq ($(words $(FPC_COMPILERINFO)),5)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
-FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
-FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
-endif
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
-endif
-ifndef CPU_TARGET
-CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
-endif
-ifndef OS_SOURCE
-OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
-endif
-ifndef OS_TARGET
-OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
-endif
-FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
-FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
-ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
-TARGETSUFFIX=$(OS_TARGET)
-SOURCESUFFIX=$(OS_SOURCE)
-else
-TARGETSUFFIX=$(FULL_TARGET)
-SOURCESUFFIX=$(FULL_SOURCE)
-endif
-ifneq ($(FULL_TARGET),$(FULL_SOURCE))
-CROSSCOMPILE=1
-endif
-ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
-ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
-$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
-endif
-endif
-ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
-BSDhier=1
-endif
-ifeq ($(OS_TARGET),linux)
-linuxHier=1
-endif
-export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
-ifdef FPCDIR
-override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
-override FPCDIR=wrong
-endif
-else
-override FPCDIR=wrong
-endif
-ifdef DEFAULT_FPCDIR
-ifeq ($(FPCDIR),wrong)
-override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
-override FPCDIR=wrong
-endif
-endif
-endif
-ifeq ($(FPCDIR),wrong)
-ifdef inUnix
-override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
-ifeq ($(wildcard $(FPCDIR)/units),)
-override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
-endif
-else
-override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
-override FPCDIR:=$(FPCDIR)/..
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
-override FPCDIR:=$(FPCDIR)/..
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
-override FPCDIR:=$(BASEDIR)
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
-override FPCDIR=c:/pp
-endif
-endif
-endif
-endif
-endif
-ifndef CROSSBINDIR
-CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
-endif
-ifndef BINUTILSPREFIX
-ifndef CROSSBINDIR
-ifdef CROSSCOMPILE
-BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
-endif
-endif
-endif
-UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
-ifeq ($(UNITSDIR),)
-UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
-endif
-PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
-override PACKAGE_NAME=compiler
-override PACKAGE_VERSION=2.0.0
-unexport FPC_VERSION FPC_COMPILERINFO
-CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64
-ALLTARGETS=$(CYCLETARGETS) m68k
-ifdef ALPHA
-PPC_TARGET=alpha
-endif
-ifdef POWERPC
-PPC_TARGET=powerpc
-endif
-ifdef POWERPC64
-PPC_TARGET=powerpc64
-endif
-ifdef SPARC
-PPC_TARGET=sparc
-endif
-ifdef M68K
-PPC_TARGET=m68k
-endif
-ifdef I386
-PPC_TARGET=i386
-endif
-ifdef X86_64
-PPC_TARGET=x86_64
-endif
-ifdef ARM
-PPC_TARGET=arm
-endif
-ifndef PPC_TARGET
-PPC_TARGET=$(CPU_TARGET)
-endif
-ifndef PPC_OS
-PPC_OS=$(OS_TARGET)
-endif
-CPU_UNITDIR=$(PPC_TARGET)
-UTILSDIR=../utils
-COMPILERSOURCEDIR=$(PPC_TARGET) systems
-COMPILERUTILSDIR=utils
-ifndef FPCLANG
-FPCLANG=e
-endif
-ifndef LOCALOPT
-LOCALOPT:=$(OPT)
-endif
-ifndef RTLOPT
-RTLOPT:=$(OPT)
-endif
-override OPT=
-MSGFILES=$(wildcard msg/error*.msg)
-ifeq ($(PPC_TARGET),i386)
-CPUSUF=386
-endif
-ifeq ($(PPC_TARGET),alpha)
-CPUSUF=axp
-endif
-ifeq ($(PPC_TARGET),m68k)
-CPUSUF=68k
-endif
-ifeq ($(PPC_TARGET),powerpc)
-CPUSUF=ppc
-endif
-ifeq ($(PPC_TARGET),powerpc64)
-CPUSUF=ppc64
-endif
-ifeq ($(PPC_TARGET),sparc)
-CPUSUF=sparc
-endif
-ifeq ($(PPC_TARGET),x86_64)
-CPUSUF=x64
-endif
-ifeq ($(PPC_TARGET),arm)
-CPUSUF=arm
-endif
-NOCPUDEF=1
-MSGFILE=msg/error$(FPCLANG).msg
-ifeq ($(OS_TARGET),linux)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALOPT+=-dUNIX
-endif
-endif
-ifeq ($(OS_TARGET),freebsd)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALOPT+=-dUNIX
-endif
-endif
-override LOCALOPT+=-d$(PPC_TARGET) -dGDB -dBROWSERLOG
-ifeq ($(PPC_TARGET),i386)
-override LOCALOPT+=-Fux86
-endif
-ifeq ($(PPC_TARGET),x86_64)
-override LOCALOPT+=-Fux86
-endif
-ifeq ($(PPC_TARGET),powerpc)
-override LOCALOPT+=
-endif
-ifeq ($(PPC_TARGET),m68k)
-override LOCALOPT+=-dNOOPT
-endif
-ifeq ($(PPC_TARGET),sparc)
-override LOCALOPT+=
-endif
-ifeq ($(PPC_TARGET),m68k)
-ifeq ($(OS_TARGET),amiga)
-override LOCALOPT+=-Ct
-endif
-endif
-ifeq ($(PPC_TARGET),arm)
-override LOCALOPT+=-dNOOPT
-endif
-ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_DIRS+=utils
-endif
-ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_PROGRAMS+=pp
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_PROGRAMS+=pp
-endif
-override INSTALL_FPCPACKAGE=y
-ifeq ($(FULL_TARGET),i386-linux)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-go32v2)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-win32)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-os2)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-freebsd)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-beos)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-netbsd)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-solaris)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-qnx)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-netware)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-openbsd)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-wdosx)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-emx)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-watcom)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-netwlibc)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-wince)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-linux)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-netbsd)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-amiga)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-atari)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-palmos)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-linux)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-macos)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-darwin)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-morphos)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),sparc-linux)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),sparc-netbsd)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),sparc-solaris)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),x86_64-linux)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),arm-linux)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),arm-wince)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-override COMPILER_INCLUDEDIR+=$(PPC_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-linux)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-go32v2)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-win32)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-os2)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-freebsd)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-beos)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-netbsd)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-solaris)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-qnx)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-netware)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-openbsd)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-wdosx)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-emx)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-watcom)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-netwlibc)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-wince)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),m68k-linux)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),m68k-netbsd)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),m68k-amiga)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),m68k-atari)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),m68k-palmos)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),powerpc-linux)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),powerpc-macos)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),powerpc-darwin)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),powerpc-morphos)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),sparc-linux)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),sparc-netbsd)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),sparc-solaris)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),x86_64-linux)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),arm-linux)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),arm-wince)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR)
-endif
-ifeq ($(FULL_TARGET),i386-linux)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-go32v2)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-win32)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-os2)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-freebsd)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-beos)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-netbsd)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-solaris)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-qnx)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-netware)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-openbsd)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-wdosx)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-emx)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-watcom)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-netwlibc)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-wince)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),m68k-linux)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),m68k-netbsd)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),m68k-amiga)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),m68k-atari)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),m68k-palmos)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),powerpc-linux)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),powerpc-macos)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),powerpc-darwin)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),powerpc-morphos)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),sparc-linux)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),sparc-netbsd)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),sparc-solaris)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),x86_64-linux)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),arm-linux)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),arm-wince)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-override COMPILER_TARGETDIR+=.
-endif
-ifeq ($(FULL_TARGET),i386-linux)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-go32v2)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-win32)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-os2)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-freebsd)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-beos)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-netbsd)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-solaris)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-qnx)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-netware)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-openbsd)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-wdosx)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-emx)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-watcom)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-netwlibc)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),i386-wince)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-linux)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-netbsd)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-amiga)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-atari)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),m68k-palmos)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-linux)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-macos)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-darwin)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc-morphos)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),sparc-linux)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),sparc-netbsd)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),sparc-solaris)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),x86_64-linux)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),arm-linux)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),arm-wince)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-endif
-ifdef REQUIRE_UNITSDIR
-override UNITSDIR+=$(REQUIRE_UNITSDIR)
-endif
-ifdef REQUIRE_PACKAGESDIR
-override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
-endif
-ifdef ZIPINSTALL
-ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
-UNIXHier=1
-endif
-else
-ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
-UNIXHier=1
-endif
-endif
-ifndef INSTALL_PREFIX
-ifdef PREFIX
-INSTALL_PREFIX=$(PREFIX)
-endif
-endif
-ifndef INSTALL_PREFIX
-ifdef UNIXHier
-INSTALL_PREFIX=/usr/local
-else
-ifdef INSTALL_FPCPACKAGE
-INSTALL_BASEDIR:=/pp
-else
-INSTALL_BASEDIR:=/$(PACKAGE_NAME)
-endif
-endif
-endif
-export INSTALL_PREFIX
-ifdef INSTALL_FPCSUBDIR
-export INSTALL_FPCSUBDIR
-endif
-ifndef DIST_DESTDIR
-DIST_DESTDIR:=$(BASEDIR)
-endif
-export DIST_DESTDIR
-ifndef COMPILER_UNITTARGETDIR
-ifdef PACKAGEDIR_MAIN
-COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
-else
-COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
-endif
-endif
-ifndef COMPILER_TARGETDIR
-COMPILER_TARGETDIR=.
-endif
-ifndef INSTALL_BASEDIR
-ifdef UNIXHier
-ifdef INSTALL_FPCPACKAGE
-INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
-else
-INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
-endif
-else
-INSTALL_BASEDIR:=$(INSTALL_PREFIX)
-endif
-endif
-ifndef INSTALL_BINDIR
-ifdef UNIXHier
-INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
-else
-INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
-ifdef INSTALL_FPCPACKAGE
-ifdef CROSSCOMPILE
-ifdef CROSSINSTALL
-INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
-else
-INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
-endif
-else
-INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
-endif
-endif
-endif
-endif
-ifndef INSTALL_UNITDIR
-INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
-ifdef INSTALL_FPCPACKAGE
-ifdef PACKAGE_NAME
-INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
-endif
-endif
-endif
-ifndef INSTALL_LIBDIR
-ifdef UNIXHier
-INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
-else
-INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
-endif
-endif
-ifndef INSTALL_SOURCEDIR
-ifdef UNIXHier
-ifdef BSDhier
-SRCPREFIXDIR=share/src
-else
-ifdef linuxHier
-SRCPREFIXDIR=share/src
-else
-SRCPREFIXDIR=src
-endif
-endif
-ifdef INSTALL_FPCPACKAGE
-ifdef INSTALL_FPCSUBDIR
-INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
-else
-INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
-endif
-else
-INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-endif
-else
-ifdef INSTALL_FPCPACKAGE
-ifdef INSTALL_FPCSUBDIR
-INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
-else
-INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
-endif
-else
-INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
-endif
-endif
-endif
-ifndef INSTALL_DOCDIR
-ifdef UNIXHier
-ifdef BSDhier
-DOCPREFIXDIR=share/doc
-else
-ifdef linuxHier
-DOCPREFIXDIR=share/doc
-else
-DOCPREFIXDIR=doc
-endif
-endif
-ifdef INSTALL_FPCPACKAGE
-INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
-else
-INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-endif
-else
-ifdef INSTALL_FPCPACKAGE
-INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
-else
-INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
-endif
-endif
-endif
-ifndef INSTALL_EXAMPLEDIR
-ifdef UNIXHier
-ifdef INSTALL_FPCPACKAGE
-ifdef BSDhier
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
-else
-ifdef linuxHier
-INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
-else
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
-endif
-endif
-else
-ifdef BSDhier
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-else
-ifdef linuxHier
-INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-else
-INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
-endif
-endif
-endif
-else
-ifdef INSTALL_FPCPACKAGE
-INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
-else
-INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
-endif
-endif
-endif
-ifndef INSTALL_DATADIR
-INSTALL_DATADIR=$(INSTALL_BASEDIR)
-endif
-ifdef CROSSCOMPILE
-ifndef CROSSBINDIR
-CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
-ifeq ($(CROSSBINDIR),)
-CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
-endif
-endif
-else
-CROSSBINDIR=
-endif
-BATCHEXT=.bat
-LOADEREXT=.as
-EXEEXT=.exe
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-STATICLIBPREFIX=libp
-RSTEXT=.rst
-ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
-ifeq ($(OS_TARGET),go32v1)
-STATICLIBPREFIX=
-SHORTSUFFIX=v1
-endif
-ifeq ($(OS_TARGET),go32v2)
-STATICLIBPREFIX=
-SHORTSUFFIX=dos
-endif
-ifeq ($(OS_TARGET),watcom)
-STATICLIBPREFIX=
-OEXT=.obj
-ASMEXT=.asm
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=wat
-endif
-ifeq ($(OS_TARGET),linux)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=lnx
-endif
-ifeq ($(OS_TARGET),freebsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=fbs
-endif
-ifeq ($(OS_TARGET),netbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=nbs
-endif
-ifeq ($(OS_TARGET),openbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=obs
-endif
-ifeq ($(OS_TARGET),win32)
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=w32
-endif
-ifeq ($(OS_TARGET),os2)
-BATCHEXT=.cmd
-AOUTEXT=.out
-STATICLIBPREFIX=
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=os2
-ECHO=echo
-endif
-ifeq ($(OS_TARGET),emx)
-BATCHEXT=.cmd
-AOUTEXT=.out
-STATICLIBPREFIX=
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=emx
-ECHO=echo
-endif
-ifeq ($(OS_TARGET),amiga)
-EXEEXT=
-SHAREDLIBEXT=.library
-SHORTSUFFIX=amg
-endif
-ifeq ($(OS_TARGET),morphos)
-EXEEXT=
-SHAREDLIBEXT=.library
-SHORTSUFFIX=mos
-endif
-ifeq ($(OS_TARGET),atari)
-EXEEXT=.ttp
-SHORTSUFFIX=ata
-endif
-ifeq ($(OS_TARGET),beos)
-BATCHEXT=.sh
-EXEEXT=
-SHORTSUFFIX=be
-endif
-ifeq ($(OS_TARGET),solaris)
-BATCHEXT=.sh
-EXEEXT=
-SHORTSUFFIX=sun
-endif
-ifeq ($(OS_TARGET),qnx)
-BATCHEXT=.sh
-EXEEXT=
-SHORTSUFFIX=qnx
-endif
-ifeq ($(OS_TARGET),netware)
-EXEEXT=.nlm
-STATICLIBPREFIX=
-SHORTSUFFIX=nw
-endif
-ifeq ($(OS_TARGET),netwlibc)
-EXEEXT=.nlm
-STATICLIBPREFIX=
-SHORTSUFFIX=nwl
-endif
-ifeq ($(OS_TARGET),macos)
-BATCHEXT=
-EXEEXT=
-DEBUGSYMEXT=.xcoff
-SHORTSUFFIX=mac
-endif
-ifeq ($(OS_TARGET),darwin)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=dwn
-endif
-else
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-STATICLIBPREFIX=
-SHORTSUFFIX=v1
-endif
-ifeq ($(OS_TARGET),go32v2)
-STATICLIBPREFIX=
-SHORTSUFFIX=dos
-endif
-ifeq ($(OS_TARGET),watcom)
-STATICLIBPREFIX=
-SHORTSUFFIX=wat
-endif
-ifeq ($(OS_TARGET),linux)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=lnx
-endif
-ifeq ($(OS_TARGET),freebsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=fbs
-endif
-ifeq ($(OS_TARGET),netbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=nbs
-endif
-ifeq ($(OS_TARGET),openbsd)
-BATCHEXT=.sh
-EXEEXT=
-HASSHAREDLIB=1
-SHORTSUFFIX=obs
-endif
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=w32
-endif
-ifeq ($(OS_TARGET),os2)
-BATCHEXT=.cmd
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-AOUTEXT=.out
-SMARTEXT=.sl2
-STATICLIBPREFIX=
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-SHORTSUFFIX=os2
-ECHO=echo
-endif
-ifeq ($(OS_TARGET),amiga)
-EXEEXT=
-PPUEXT=.ppu
-ASMEXT=.asm
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.library
-SHORTSUFFIX=amg
-endif
-ifeq ($(OS_TARGET),atari)
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=.ttp
-SHORTSUFFIX=ata
-endif
-ifeq ($(OS_TARGET),beos)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=be
-endif
-ifeq ($(OS_TARGET),solaris)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=sun
-endif
-ifeq ($(OS_TARGET),qnx)
-BATCHEXT=.sh
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-SHORTSUFFIX=qnx
-endif
-ifeq ($(OS_TARGET),netware)
-STATICLIBPREFIX=
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.nlm
-EXEEXT=.nlm
-SHORTSUFFIX=nw
-endif
-ifeq ($(OS_TARGET),netwlibc)
-STATICLIBPREFIX=
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.nlm
-EXEEXT=.nlm
-SHORTSUFFIX=nwl
-endif
-ifeq ($(OS_TARGET),macos)
-BATCHEXT=
-PPUEXT=.ppu
-ASMEXT=.s
-OEXT=.o
-SMARTEXT=.sl
-STATICLIBEXT=.a
-EXEEXT=
-DEBUGSYMEXT=.xcoff
-SHORTSUFFIX=mac
-endif
-endif
-ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
-FPCMADE=fpcmade.$(SHORTSUFFIX)
-ZIPSUFFIX=$(SHORTSUFFIX)
-ZIPCROSSPREFIX=
-ZIPSOURCESUFFIX=src
-ZIPEXAMPLESUFFIX=exm
-else
-FPCMADE=fpcmade.$(TARGETSUFFIX)
-ZIPSOURCESUFFIX=.source
-ZIPEXAMPLESUFFIX=.examples
-ifdef CROSSCOMPILE
-ZIPSUFFIX=.$(SOURCESUFFIX)
-ZIPCROSSPREFIX=$(TARGETSUFFIX)-
-else
-ZIPSUFFIX=.$(TARGETSUFFIX)
-ZIPCROSSPREFIX=
-endif
-endif
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO= __missing_command_ECHO
-else
-ECHO:=$(firstword $(ECHO))
-endif
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-ifndef DATE
-DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE= __missing_command_DATE
-else
-DATE:=$(firstword $(DATE))
-endif
-else
-DATE:=$(firstword $(DATE))
-endif
-endif
-export DATE
-ifndef GINSTALL
-GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(GINSTALL),)
-GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(GINSTALL),)
-GINSTALL= __missing_command_GINSTALL
-else
-GINSTALL:=$(firstword $(GINSTALL))
-endif
-else
-GINSTALL:=$(firstword $(GINSTALL))
-endif
-endif
-export GINSTALL
-ifndef CPPROG
-CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(CPPROG),)
-CPPROG= __missing_command_CPPROG
-else
-CPPROG:=$(firstword $(CPPROG))
-endif
-endif
-export CPPROG
-ifndef RMPROG
-RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(RMPROG),)
-RMPROG= __missing_command_RMPROG
-else
-RMPROG:=$(firstword $(RMPROG))
-endif
-endif
-export RMPROG
-ifndef MVPROG
-MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(MVPROG),)
-MVPROG= __missing_command_MVPROG
-else
-MVPROG:=$(firstword $(MVPROG))
-endif
-endif
-export MVPROG
-ifndef MKDIRPROG
-MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(MKDIRPROG),)
-MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(MKDIRPROG),)
-MKDIRPROG= __missing_command_MKDIRPROG
-else
-MKDIRPROG:=$(firstword $(MKDIRPROG))
-endif
-else
-MKDIRPROG:=$(firstword $(MKDIRPROG))
-endif
-endif
-export MKDIRPROG
-ifndef ECHOREDIR
-ifndef inUnix
-ECHOREDIR=echo
-else
-ECHOREDIR=$(ECHO)
-endif
-endif
-ifndef COPY
-COPY:=$(CPPROG) -fp
-endif
-ifndef COPYTREE
-COPYTREE:=$(CPPROG) -Rfp
-endif
-ifndef MKDIRTREE
-MKDIRTREE:=$(MKDIRPROG) -p
-endif
-ifndef MOVE
-MOVE:=$(MVPROG) -f
-endif
-ifndef DEL
-DEL:=$(RMPROG) -f
-endif
-ifndef DELTREE
-DELTREE:=$(RMPROG) -rf
-endif
-ifndef INSTALL
-ifdef inUnix
-INSTALL:=$(GINSTALL) -c -m 644
-else
-INSTALL:=$(COPY)
-endif
-endif
-ifndef INSTALLEXE
-ifdef inUnix
-INSTALLEXE:=$(GINSTALL) -c -m 755
-else
-INSTALLEXE:=$(COPY)
-endif
-endif
-ifndef MKDIR
-MKDIR:=$(GINSTALL) -m 755 -d
-endif
-export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE= __missing_command_PPUMOVE
-else
-PPUMOVE:=$(firstword $(PPUMOVE))
-endif
-endif
-export PPUMOVE
-ifndef FPCMAKE
-FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(FPCMAKE),)
-FPCMAKE= __missing_command_FPCMAKE
-else
-FPCMAKE:=$(firstword $(FPCMAKE))
-endif
-endif
-export FPCMAKE
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG= __missing_command_ZIPPROG
-else
-ZIPPROG:=$(firstword $(ZIPPROG))
-endif
-endif
-export ZIPPROG
-ifndef TARPROG
-TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(TARPROG),)
-TARPROG= __missing_command_TARPROG
-else
-TARPROG:=$(firstword $(TARPROG))
-endif
-endif
-export TARPROG
-ASNAME=$(BINUTILSPREFIX)as
-LDNAME=$(BINUTILSPREFIX)ld
-ARNAME=$(BINUTILSPREFIX)ar
-RCNAME=$(BINUTILSPREFIX)rc
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-ifeq ($(OS_TARGET),win32)
-ifeq ($(CROSSBINDIR),)
-ASNAME=asw
-LDNAME=ldw
-ARNAME=arw
-endif
-endif
-endif
-ifndef ASPROG
-ifdef CROSSBINDIR
-ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
-else
-ASPROG=$(ASNAME)
-endif
-endif
-ifndef LDPROG
-ifdef CROSSBINDIR
-LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
-else
-LDPROG=$(LDNAME)
-endif
-endif
-ifndef RCPROG
-ifdef CROSSBINDIR
-RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
-else
-RCPROG=$(RCNAME)
-endif
-endif
-ifndef ARPROG
-ifdef CROSSBINDIR
-ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
-else
-ARPROG=$(ARNAME)
-endif
-endif
-AS=$(ASPROG)
-LD=$(LDPROG)
-RC=$(RCPROG)
-AR=$(ARPROG)
-PPAS=ppas$(SRCBATCHEXT)
-ifdef inUnix
-LDCONFIG=ldconfig
-else
-LDCONFIG=
-endif
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-else
-DATESTR=
-endif
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
-ZIPOPT=-9
-ZIPEXT=.zip
-ifeq ($(USETAR),bz2)
-TAROPT=vj
-TAREXT=.tar.bz2
-else
-TAROPT=vz
-TAREXT=.tar.gz
-endif
-override REQUIRE_PACKAGES=rtl rtl
-ifeq ($(FULL_TARGET),i386-linux)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-go32v2)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-win32)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-os2)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-freebsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-beos)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-netbsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-solaris)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-qnx)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-netware)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-openbsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-wdosx)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-emx)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-watcom)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-netwlibc)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),i386-wince)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),m68k-linux)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),m68k-netbsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),m68k-amiga)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),m68k-atari)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),m68k-palmos)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),powerpc-linux)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),powerpc-macos)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),powerpc-darwin)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),powerpc-morphos)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),sparc-linux)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),sparc-netbsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),sparc-solaris)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),x86_64-linux)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),arm-linux)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),arm-wince)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifdef REQUIRE_PACKAGES_RTL
-PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
-ifneq ($(PACKAGEDIR_RTL),)
-ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
-UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
-else
-UNITDIR_RTL=$(PACKAGEDIR_RTL)
-endif
-ifdef CHECKDEPEND
-$(PACKAGEDIR_RTL)/$(FPCMADE):
-	$(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE)
-override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE)
-endif
-else
-PACKAGEDIR_RTL=
-UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
-ifneq ($(UNITDIR_RTL),)
-UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
-else
-UNITDIR_RTL=
-endif
-endif
-ifdef UNITDIR_RTL
-override COMPILER_UNITDIR+=$(UNITDIR_RTL)
-endif
-endif
-ifndef NOCPUDEF
-override FPCOPTDEF=$(CPU_TARGET)
-endif
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-endif
-ifeq ($(OS_SOURCE),openbsd)
-override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
-endif
-ifndef CROSSBOOTSTRAP
-ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
-endif
-ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-Xr$(RLINKPATH)
-endif
-endif
-ifdef UNITDIR
-override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
-endif
-ifdef LIBDIR
-override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
-endif
-ifdef OBJDIR
-override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
-endif
-ifdef INCDIR
-override FPCOPT+=$(addprefix -Fi,$(INCDIR))
-endif
-ifdef LINKSMART
-override FPCOPT+=-XX
-endif
-ifdef CREATESMART
-override FPCOPT+=-CX
-endif
-ifdef DEBUG
-override FPCOPT+=-gl
-override FPCOPTDEF+=DEBUG
-endif
-ifdef RELEASE
-ifeq ($(CPU_TARGET),i386)
-FPCCPUOPT:=-OG2p3
-else
-ifeq ($(CPU_TARGET),powerpc)
-FPCCPUOPT:=-O1r
-else
-FPCCPUOPT:=
-endif
-endif
-override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
-override FPCOPTDEF+=RELEASE
-endif
-ifdef STRIP
-override FPCOPT+=-Xs
-endif
-ifdef OPTIMIZE
-ifeq ($(CPU_TARGET),i386)
-override FPCOPT+=-OG2p3
-endif
-endif
-ifdef VERBOSE
-override FPCOPT+=-vwni
-endif
-ifdef COMPILER_OPTIONS
-override FPCOPT+=$(COMPILER_OPTIONS)
-endif
-ifdef COMPILER_UNITDIR
-override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
-endif
-ifdef COMPILER_LIBRARYDIR
-override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
-endif
-ifdef COMPILER_OBJECTDIR
-override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
-endif
-ifdef COMPILER_INCLUDEDIR
-override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
-endif
-ifdef CROSSBINDIR
-override FPCOPT+=-FD$(CROSSBINDIR)
-endif
-ifdef COMPILER_TARGETDIR
-override FPCOPT+=-FE$(COMPILER_TARGETDIR)
-ifeq ($(COMPILER_TARGETDIR),.)
-override TARGETDIRPREFIX=
-else
-override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
-endif
-endif
-ifdef COMPILER_UNITTARGETDIR
-override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
-ifeq ($(COMPILER_UNITTARGETDIR),.)
-override UNITTARGETDIRPREFIX=
-else
-override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
-endif
-else
-ifdef COMPILER_TARGETDIR
-override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
-override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
-endif
-endif
-ifeq ($(OS_TARGET),linux)
-ifeq ($(FPC_VERSION),1.0.6)
-override FPCOPTDEF+=HASUNIX
-endif
-endif
-ifdef OPT
-override FPCOPT+=$(OPT)
-endif
-ifdef FPCOPTDEF
-override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
-endif
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-endif
-ifdef USEENV
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-endif
-override COMPILER:=$(FPC) $(FPCOPT)
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-else
-ifeq ($(FULL_SOURCE),$(FULL_TARGET))
-EXECPPAS:=@$(PPAS)
-endif
-endif
-.PHONY: fpc_exes
-ifndef CROSSINSTALL
-ifneq ($(TARGET_PROGRAMS),)
-override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))
-override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
-override ALLTARGET+=fpc_exes
-override INSTALLEXEFILES+=$(EXEFILES)
-override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
-ifeq ($(OS_TARGET),os2)
-override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))
-endif
-ifeq ($(OS_TARGET),emx)
-override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))
-endif
-endif
-endif
-fpc_exes: $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(EXEFILES)
-ifdef TARGET_RSTS
-override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
-override CLEANRSTFILES+=$(RSTFILES)
-endif
-.PHONY: fpc_all fpc_smart fpc_debug fpc_release
-$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
-	@$(ECHOREDIR) Compiled > $(FPCMADE)
-fpc_all: $(FPCMADE)
-fpc_smart:
-	$(MAKE) all LINKSMART=1 CREATESMART=1
-fpc_debug:
-	$(MAKE) all DEBUG=1
-fpc_release:
-	$(MAKE) all RELEASE=1
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
-$(COMPILER_UNITTARGETDIR):
-	$(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
-$(COMPILER_TARGETDIR):
-	$(MKDIRTREE) $(COMPILER_TARGETDIR)
-%$(PPUEXT): %.pp
-	$(COMPILER) $<
-	$(EXECPPAS)
-%$(PPUEXT): %.pas
-	$(COMPILER) $<
-	$(EXECPPAS)
-%$(EXEEXT): %.pp
-	$(COMPILER) $<
-	$(EXECPPAS)
-%$(EXEEXT): %.pas
-	$(COMPILER) $<
-	$(EXECPPAS)
-%$(EXEEXT): %.lpr
-	$(COMPILER) $<
-	$(EXECPPAS)
-%$(EXEEXT): %.dpr
-	$(COMPILER) $<
-	$(EXECPPAS)
-%.res: %.rc
-	windres -i $< -o $@
-vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
-vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
-.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
-ifdef INSTALL_UNITS
-override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
-endif
-ifdef INSTALL_BUILDUNIT
-override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
-endif
-ifdef INSTALLPPUFILES
-override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
-ifneq ($(UNITTARGETDIRPREFIX),)
-override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
-override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
-endif
-override INSTALL_CREATEPACKAGEFPC=1
-endif
-ifdef INSTALLEXEFILES
-ifneq ($(TARGETDIRPREFIX),)
-override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
-endif
-endif
-fpc_install: all $(INSTALLTARGET)
-ifdef INSTALLEXEFILES
-	$(MKDIR) $(INSTALL_BINDIR)
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
-	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
-endif
-ifdef INSTALL_CREATEPACKAGEFPC
-ifdef FPCMAKE
-ifdef PACKAGE_VERSION
-ifneq ($(wildcard Makefile.fpc),)
-	$(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
-	$(MKDIR) $(INSTALL_UNITDIR)
-	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
-endif
-endif
-endif
-endif
-ifdef INSTALLPPUFILES
-	$(MKDIR) $(INSTALL_UNITDIR)
-	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
-ifneq ($(INSTALLPPULINKFILES),)
-	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
-endif
-ifneq ($(wildcard $(LIB_FULLNAME)),)
-	$(MKDIR) $(INSTALL_LIBDIR)
-	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
-ifdef inUnix
-	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
-endif
-endif
-endif
-ifdef INSTALL_FILES
-	$(MKDIR) $(INSTALL_DATADIR)
-	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
-endif
-fpc_sourceinstall: distclean
-	$(MKDIR) $(INSTALL_SOURCEDIR)
-	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
-fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
-ifdef HASEXAMPLES
-	$(MKDIR) $(INSTALL_EXAMPLEDIR)
-endif
-ifdef EXAMPLESOURCEFILES
-	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
-endif
-ifdef TARGET_EXAMPLEDIRS
-	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
-endif
-.PHONY: fpc_distinstall
-fpc_distinstall: install exampleinstall
-.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
-ifndef PACKDIR
-ifndef inUnix
-PACKDIR=$(BASEDIR)/../fpc-pack
-else
-PACKDIR=/tmp/fpc-pack
-endif
-endif
-ifndef ZIPNAME
-ifdef DIST_ZIPNAME
-ZIPNAME=$(DIST_ZIPNAME)
-else
-ZIPNAME=$(PACKAGE_NAME)
-endif
-endif
-ifndef FULLZIPNAME
-FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)
-endif
-ifndef ZIPTARGET
-ifdef DIST_ZIPTARGET
-ZIPTARGET=DIST_ZIPTARGET
-else
-ZIPTARGET=install
-endif
-endif
-ifndef USEZIP
-ifdef inUnix
-USETAR=1
-endif
-endif
-ifndef inUnix
-USEZIPWRAPPER=1
-endif
-ifdef USEZIPWRAPPER
-ZIPPATHSEP=$(PATHSEP)
-ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))
-else
-ZIPPATHSEP=/
-endif
-ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
-ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
-ifdef USETAR
-ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
-ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
-else
-ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
-ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
-endif
-fpc_zipinstall:
-	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
-	$(MKDIR) $(DIST_DESTDIR)
-	$(DEL) $(ZIPDESTFILE)
-ifdef USEZIPWRAPPER
-ifneq ($(ECHOREDIR),echo)
-	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
-	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
-	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
-else
-	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
-	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
-	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
-endif
-ifdef inUnix
-	/bin/sh $(ZIPWRAPPER)
-else
-	$(ZIPWRAPPER)
-endif
-	$(DEL) $(ZIPWRAPPER)
-else
-	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
-endif
-	$(DELTREE) $(PACKDIR)
-fpc_zipsourceinstall:
-	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX)
-fpc_zipexampleinstall:
-ifdef HASEXAMPLES
-	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX)
-endif
-fpc_zipdistinstall:
-	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
-.PHONY: fpc_clean fpc_cleanall fpc_distclean
-ifdef EXEFILES
-override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
-endif
-ifdef CLEAN_UNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
-endif
-ifdef CLEANPPUFILES
-override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
-ifdef DEBUGSYMEXT
-override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
-endif
-override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
-override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
-endif
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef CLEANRSTFILES
-	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
-endif
-ifdef CLEAN_FILES
-	-$(DEL) $(CLEAN_FILES)
-endif
-ifdef LIB_NAME
-	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
-endif
-	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
-fpc_cleanall: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef COMPILER_UNITTARGETDIR
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef CLEANRSTFILES
-	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
-endif
-endif
-	-$(DELTREE) units
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-ifneq ($(PPUEXT),.ppu)
-	-$(DEL) *.o *.ppu *.a
-endif
-	-$(DELTREE) *$(SMARTEXT)
-	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-	-$(DEL) *_ppas$(BATCHEXT)
-ifdef AOUTEXT
-	-$(DEL) *$(AOUTEXT)
-endif
-ifdef DEBUGSYMEXT
-	-$(DEL) *$(DEBUGSYMEXT)
-endif
-fpc_distclean: cleanall
-.PHONY: fpc_baseinfo
-override INFORULES+=fpc_baseinfo
-fpc_baseinfo:
-	@$(ECHO)
-	@$(ECHO)  == Package info ==
-	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
-	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
-	@$(ECHO)
-	@$(ECHO)  == Configuration info ==
-	@$(ECHO)
-	@$(ECHO)  FPC.......... $(FPC)
-	@$(ECHO)  FPC Version.. $(FPC_VERSION)
-	@$(ECHO)  Source CPU... $(CPU_SOURCE)
-	@$(ECHO)  Target CPU... $(CPU_TARGET)
-	@$(ECHO)  Source OS.... $(OS_SOURCE)
-	@$(ECHO)  Target OS.... $(OS_TARGET)
-	@$(ECHO)  Full Source.. $(FULL_SOURCE)
-	@$(ECHO)  Full Target.. $(FULL_TARGET)
-	@$(ECHO)  SourceSuffix. $(SOURCESUFFIX)
-	@$(ECHO)  TargetSuffix. $(TARGETSUFFIX)
-	@$(ECHO)
-	@$(ECHO)  == Directory info ==
-	@$(ECHO)
-	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
-	@$(ECHO)
-	@$(ECHO)  Basedir......... $(BASEDIR)
-	@$(ECHO)  FPCDir.......... $(FPCDIR)
-	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
-	@$(ECHO)  UnitsDir........ $(UNITSDIR)
-	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
-	@$(ECHO)
-	@$(ECHO)  GCC library..... $(GCCLIBDIR)
-	@$(ECHO)  Other library... $(OTHERLIBDIR)
-	@$(ECHO)
-	@$(ECHO)  == Tools info ==
-	@$(ECHO)
-	@$(ECHO)  As........ $(AS)
-	@$(ECHO)  Ld........ $(LD)
-	@$(ECHO)  Ar........ $(AR)
-	@$(ECHO)  Rc........ $(RC)
-	@$(ECHO)
-	@$(ECHO)  Mv........ $(MVPROG)
-	@$(ECHO)  Cp........ $(CPPROG)
-	@$(ECHO)  Rm........ $(RMPROG)
-	@$(ECHO)  GInstall.. $(GINSTALL)
-	@$(ECHO)  Echo...... $(ECHO)
-	@$(ECHO)  Shell..... $(SHELL)
-	@$(ECHO)  Date...... $(DATE)
-	@$(ECHO)  FPCMake... $(FPCMAKE)
-	@$(ECHO)  PPUMove... $(PPUMOVE)
-	@$(ECHO)  Upx....... $(UPXPROG)
-	@$(ECHO)  Zip....... $(ZIPPROG)
-	@$(ECHO)
-	@$(ECHO)  == Object info ==
-	@$(ECHO)
-	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
-	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
-	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
-	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
-	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
-	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
-	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
-	@$(ECHO)
-	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
-	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
-	@$(ECHO)
-	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
-	@$(ECHO)  Install Files....... $(INSTALL_FILES)
-	@$(ECHO)
-	@$(ECHO)  == Install info ==
-	@$(ECHO)
-	@$(ECHO)  DateStr.............. $(DATESTR)
-	@$(ECHO)  ZipName.............. $(ZIPNAME)
-	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
-	@$(ECHO)  ZipCrossPrefix....... $(ZIPCROSSPREFIX)
-	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
-	@$(ECHO)  FullZipName.......... $(FULLZIPNAME)
-	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
-	@$(ECHO)
-	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
-	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
-	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
-	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
-	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
-	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
-	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
-	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
-	@$(ECHO)
-	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
-	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
-	@$(ECHO)
-.PHONY: fpc_info
-fpc_info: $(INFORULES)
-.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
-	fpc_makefile_dirs
-fpc_makefile:
-	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
-fpc_makefile_sub1:
-ifdef TARGET_DIRS
-	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
-endif
-ifdef TARGET_EXAMPLEDIRS
-	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
-endif
-fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
-fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
-fpc_makefiles: fpc_makefile fpc_makefile_dirs
-ifeq ($(FULL_TARGET),i386-linux)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-go32v2)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-win32)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-os2)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-freebsd)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-beos)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-netbsd)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-solaris)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-qnx)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-netware)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-openbsd)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-wdosx)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-emx)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-watcom)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-netwlibc)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),i386-wince)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),m68k-linux)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),m68k-netbsd)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),m68k-amiga)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),m68k-atari)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),m68k-palmos)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),powerpc-linux)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),powerpc-netbsd)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),powerpc-macos)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),powerpc-darwin)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),powerpc-morphos)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),sparc-linux)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),sparc-netbsd)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),sparc-solaris)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),x86_64-linux)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),x86_64-freebsd)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),x86_64-win64)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),arm-linux)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),arm-wince)
-TARGET_DIRS_UTILS=1
-endif
-ifeq ($(FULL_TARGET),powerpc64-linux)
-TARGET_DIRS_UTILS=1
-endif
-ifdef TARGET_DIRS_UTILS
-utils_all:
-	$(MAKE) -C utils all
-utils_debug:
-	$(MAKE) -C utils debug
-utils_smart:
-	$(MAKE) -C utils smart
-utils_release:
-	$(MAKE) -C utils release
-utils_units:
-	$(MAKE) -C utils units
-utils_examples:
-	$(MAKE) -C utils examples
-utils_shared:
-	$(MAKE) -C utils shared
-utils_install:
-	$(MAKE) -C utils install
-utils_sourceinstall:
-	$(MAKE) -C utils sourceinstall
-utils_exampleinstall:
-	$(MAKE) -C utils exampleinstall
-utils_distinstall:
-	$(MAKE) -C utils distinstall
-utils_zipinstall:
-	$(MAKE) -C utils zipinstall
-utils_zipsourceinstall:
-	$(MAKE) -C utils zipsourceinstall
-utils_zipexampleinstall:
-	$(MAKE) -C utils zipexampleinstall
-utils_zipdistinstall:
-	$(MAKE) -C utils zipdistinstall
-utils_clean:
-	$(MAKE) -C utils clean
-utils_distclean:
-	$(MAKE) -C utils distclean
-utils_cleanall:
-	$(MAKE) -C utils cleanall
-utils_info:
-	$(MAKE) -C utils info
-utils_makefiles:
-	$(MAKE) -C utils makefiles
-utils:
-	$(MAKE) -C utils all
-.PHONY: utils_all utils_debug utils_smart utils_release utils_units utils_examples utils_shared utils_install utils_sourceinstall utils_exampleinstall utils_distinstall utils_zipinstall utils_zipsourceinstall utils_zipexampleinstall utils_zipdistinstall utils_clean utils_distclean utils_cleanall utils_info utils_makefiles utils
-endif
-ifndef DIFF
-DIFF:=$(strip $(wildcard $(addsuffix /diff$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(DIFF),)
-DIFF= __missing_command_DIFF
-else
-DIFF:=$(firstword $(DIFF))
-endif
-endif
-export DIFF
-ifndef CMP
-CMP:=$(strip $(wildcard $(addsuffix /cmp$(SRCEXEEXT),$(SEARCHPATH))))
-ifeq ($(CMP),)
-CMP= __missing_command_CMP
-else
-CMP:=$(firstword $(CMP))
-endif
-endif
-export CMP
-debug: fpc_debug
-smart: fpc_smart
-release: fpc_release
-units: fpc_units $(addsuffix _units,$(TARGET_DIRS))
-examples: $(addsuffix _examples,$(TARGET_DIRS))
-shared: $(addsuffix _shared,$(TARGET_DIRS))
-sourceinstall: fpc_sourceinstall
-exampleinstall: fpc_exampleinstall $(addsuffix _exampleinstall,$(TARGET_DIRS))
-distinstall: fpc_distinstall
-zipinstall: fpc_zipinstall
-zipsourceinstall: fpc_zipsourceinstall
-zipexampleinstall: fpc_zipexampleinstall $(addsuffix _zipexampleinstall,$(TARGET_DIRS))
-zipdistinstall: fpc_zipdistinstall
-cleanall: fpc_cleanall $(addsuffix _cleanall,$(TARGET_DIRS))
-info: fpc_info
-makefiles: fpc_makefiles
-.PHONY: debug smart release units examples shared sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall cleanall info makefiles
-ifneq ($(wildcard fpcmake.loc),)
-include fpcmake.loc
-endif
-ifeq ($(OS_TARGET),win32)
-ifdef CMP
-override DIFF:=$(CMP) -i218
-endif
-endif
-override COMPILER+=$(LOCALOPT)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override COMPILER:=$(patsubst -O%,,$(COMPILER))
-endif
-PASDOC:=$(strip $(wildcard $(addsuffix /pasdoc.exe,$(SEARCHPATH))))
-ifeq ($(PASDOC),)
-PASDOC:=$(strip $(wildcard $(addsuffix /pasdoc,$(SEARCHPATH))))
-endif
-ifeq ($(PASDOC),)
-PASDOC:=../projects/pasdoc/bin/pasdoc
-else
-PASDOC:=$(firstword $(PASDOC))
-endif
-ifndef EXENAME
-EXENAME=ppc$(CPUSUF)$(EXEEXT)
-endif
-PPEXENAME=pp$(EXEEXT)
-TEMPNAME=ppc$(SRCEXEEXT)
-PPCROSSNAME=ppcross$(CPUSUF)$(SRCEXEEXT)
-TEMPNAME1=ppc1$(EXEEXT)
-TEMPNAME2=ppc2$(EXEEXT)
-TEMPNAME3=ppc3$(EXEEXT)
-MAKEDEP=ppdep$(EXEEXT)
-MSG2INC=./msg2inc$(EXEEXT)
-ifdef CROSSINSTALL
-INSTALLEXEFILE=$(PPCROSSNAME)
-else
-INSTALLEXEFILE=$(EXENAME)
-endif
-PPC_TARGETS=alpha i386 m68k powerpc sparc arm x86_64
-.PHONY: $(PPC_TARGETS)
-$(PPC_TARGETS):
-	$(MAKE) PPC_TARGET=$@ CPU_UNITDIR=$@ all
-.PHONY: all compiler echotime ppuclean execlean clean distclean
-all: compiler $(addsuffix _all,$(TARGET_DIRS))
-compiler: $(COMPILER_UNITTARGETDIR) $(COMPILER_TARGETDIR) $(EXENAME)
-ifeq ($(MAKELEVEL),0)
-ifndef STARTTIME
-ifdef DATE
-STARTTIME:=$(shell $(DATE) +%T)
-else
-STARTTIME:=unknown
-endif
-endif
-endif
-export STARTTIME
-ifdef DATE
-ENDTIME=$(shell $(DATE) +%T)
-else
-ENDTIME:=unknown
-endif
-echotime:
-	@echo Start $(STARTTIME) now $(ENDTIME)
-ppuclean:
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-	-$(DEL) $(addsuffix /*$(PPUEXT),$(COMPILERSOURCEDIR))
-tempclean:
-	-$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC)
-execlean :
-	-$(DEL) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) $(EXENAME)
-$(addsuffix _clean,$(ALLTARGETS)):
-	-$(DELTREE) $(addprefix $(subst _clean,,$@),/units)
-	-$(DEL) $(addprefix $(subst _clean,,$@)/,*$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT))
-	-$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcppc$(EXEEXT) $(EXENAME))
-cycleclean: cleanall $(addsuffix _clean,$(PPC_TARGET))
-	-$(DEL) $(EXENAME)
-clean: tempclean execlean cleanall $(addsuffix _clean,$(PPC_TARGET)) $(addsuffix _clean,$(TARGET_DIRS))
-distclean: tempclean execlean cleanall $(addsuffix _clean,$(ALLTARGETS)) $(addsuffix _distclean,$(TARGET_DIRS))
-$(MSG2INC): $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(COMPILERUTILSDIR)/msg2inc.pp
-	$(COMPILER) -FE. $(COMPILERUTILSDIR)/msg2inc.pp
-msgtxt.inc: $(MSGFILE)
-	$(MAKE) $(MSG2INC)
-	$(MSG2INC) $(MSGFILE) msg msg
-msg: msgtxt.inc
-$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg \
-	     $(wildcard systems/*.pas) $(wilcard systems/*.inc) \
-	     $(wildcard $(PPC_TARGET)/*.pas) $(wildcard $(PPC_TARGET)/*.inc)
-	$(COMPILER) pp.pas
-	$(EXECPPAS)
-	$(MOVE) $(COMPILER_TARGETDIR)/$(PPEXENAME) $(EXENAME)
-ifeq ($(CPU_SOURCE),$(PPC_TARGET))
-ifeq ($(OS_SOURCE),$(OS_TARGET))
-ifdef DIFF
-ifdef OLDFPC
-DIFFRESULT:=$(shell $(DIFF) $(OLDFPC) $(FPC))
-else
-DIFFRESULT=Not equal
-endif
-else
-DIFFRESULT=No diff program
-endif
-ifndef DIFFRESULT
-next :
-	@echo $(OLDFPC) and $(FPC) are equal
-	$(COPY) $(FPC) $(EXENAME)
-else
-next :
-	$(MAKE) rtlclean rtl
-	$(MAKE) cycleclean compiler
-	$(MAKE) echotime
-endif
-$(TEMPNAME1) :
-	$(MAKE) 'OLDFPC=' next
-	-$(DEL) $(TEMPNAME1)
-	$(MOVE) $(EXENAME) $(TEMPNAME1)
-$(TEMPNAME2) : $(TEMPNAME1)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME1)' 'OLDFPC=' next
-	-$(DEL) $(TEMPNAME2)
-	$(MOVE) $(EXENAME) $(TEMPNAME2)
-$(TEMPNAME3) : $(TEMPNAME2)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME2)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME1)' next
-	-$(DEL) $(TEMPNAME3)
-	$(MOVE) $(EXENAME) $(TEMPNAME3)
-cycle:
-	$(MAKE) tempclean $(TEMPNAME3)
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next
-	$(DIFF) $(TEMPNAME3) $(EXENAME)
-	$(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAME)'
-	$(MAKE) echotime
-else
-cycle:
-	$(MAKE) OS_TARGET=$(OS_SOURCE) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-	$(MAKE) OS_TARGET=$(OS_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
-ifndef CROSSINSTALL
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler
-endif
-endif
-else
-cycle:
-	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-	$(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
-ifndef CROSSINSTALL
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl
-	$(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler
-endif
-endif
-cycledep:
-	$(MAKE) cycle USEDEPEND=1
-extcycle:
-	$(MAKE) cycle OPT='-n -OG2p3 -gl -CRriot -dEXTDEBUG'
-cvstest:
-	$(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'
-full: fullcycle
-fullcycle:
-	$(MAKE) cycle
-	$(MAKE) ppuclean
-	$(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAME)'
-htmldocs:
-	$(PASDOC) -p -h -o html$(PATHSEP)$(PPC_TARGET) -d fpc -d gdb -d $(PPC_TARGET) -u $(PPC_TARGET) $(PPC_TARGET)$(PATHSEP)*.pas systems$(PATHSEP)*.pas *.pas
-.PHONY: quickinstall install installsym
-MSGINSTALLDIR=$(INSTALL_BASEDIR)/msg
-override PPEXEFILE:=$(wildcard $(EXENAME))
-ifdef UNIXHier
-PPCCPULOCATION=$(INSTALL_BASEDIR)
-else
-PPCCPULOCATION=$(INSTALL_BINDIR)
-endif
-quickinstall: $(addsuffix _install,$(TARGET_DIRS))
-ifneq ($(INSTALLEXEFILE),)
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILE)
-endif
-	$(MKDIR) $(PPCCPULOCATION)
-	$(INSTALLEXE) $(INSTALLEXEFILE) $(PPCCPULOCATION)/$(EXENAME)
-endif
-install: quickinstall
-ifndef CROSSINSTALL
-ifdef UNIXHier
-	$(MKDIR) $(INSTALL_BASEDIR)
-	$(INSTALLEXE) $(COMPILERUTILSDIR)/samplecfg $(INSTALL_BASEDIR)/samplecfg
-endif
-	$(MKDIR) $(MSGINSTALLDIR)
-	$(INSTALL) $(MSGFILES) $(MSGINSTALLDIR)
-endif
-installsymlink: install
-ifneq ($(PPCCPULOCATION),$(INSTALL_BINDIR))
-	$(MKDIR) $(INSTALL_BINDIR)
-	ln -sf $(INSTALL_BASEDIR)/$(EXENAME) $(INSTALL_BINDIR)/$(EXENAME)
-endif
-.PHONY: rtl rtlclean rtlinstall
-rtl:
-	$(MAKE) -C $(PACKAGEDIR_RTL) 'OPT=$(RTLOPT)' all
-rtlclean:
-	$(MAKE) -C $(PACKAGEDIR_RTL) clean
-rtlinstall:
-	$(MAKE) -C $(PACKAGEDIR_RTL) install
-localmake:=$(strip $(wildcard makefile.loc))
-ifdef localmake
-include ./$(localmake)
-endif

compiler/compiler/Makefile.fpc

@@ -1,563 +0,0 @@
-#
-#   Makefile.fpc for Free Pascal Compiler
-#
-
-[package]
-name=compiler
-version=2.0.0
-
-[target]
-programs=pp
-dirs=utils
-
-[compiler]
-targetdir=.
-unittargetdir=$(CPU_UNITDIR)/units/$(FULL_TARGET)
-unitdir=$(COMPILERSOURCEDIR)
-includedir=$(PPC_TARGET)
-
-[require]
-packages=rtl
-tools=diff cmp
-
-[install]
-fpcpackage=y
-
-[default]
-fpcdir=..
-
-
-[prerules]
-# Don't export version it can change after the first compile
-unexport FPC_VERSION FPC_COMPILERINFO
-
-# Which platforms are ready for inclusion in the cycle
-CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64
-
-# All supported targets used for clean
-ALLTARGETS=$(CYCLETARGETS) m68k
-
-# Allow ALPHA, POWERPC, POWERPC64, M68K, I386 defines for target cpu
-ifdef ALPHA
-PPC_TARGET=alpha
-endif
-ifdef POWERPC
-PPC_TARGET=powerpc
-endif
-ifdef POWERPC64
-PPC_TARGET=powerpc64
-endif
-ifdef SPARC
-PPC_TARGET=sparc
-endif
-ifdef M68K
-PPC_TARGET=m68k
-endif
-ifdef I386
-PPC_TARGET=i386
-endif
-ifdef X86_64
-PPC_TARGET=x86_64
-endif
-ifdef ARM
-PPC_TARGET=arm
-endif
-
-# Default is to generate a compiler for the same
-# platform as CPU_TARGET (a native compiler)
-ifndef PPC_TARGET
-PPC_TARGET=$(CPU_TARGET)
-endif
-
-# Default is to generate a compiler for the same
-# target as OS_TARGET (a native compiler)
-ifndef PPC_OS
-PPC_OS=$(OS_TARGET)
-endif
-
-# Where to place the unit files.
-CPU_UNITDIR=$(PPC_TARGET)
-
-# RTL
-UTILSDIR=../utils
-
-# Directories containing compiler sources
-COMPILERSOURCEDIR=$(PPC_TARGET) systems
-
-# Utils used by compiler development/installation
-COMPILERUTILSDIR=utils
-
-# Default language for the compiler
-ifndef FPCLANG
-FPCLANG=e
-endif
-
-# Local options for the compiler only
-ifndef LOCALOPT
-LOCALOPT:=$(OPT)
-endif
-
-# Options for the RTL only when cycling
-ifndef RTLOPT
-RTLOPT:=$(OPT)
-endif
-
-# Make OPT empty. It is copied to LOCALOPT and RTLOPT
-override OPT=
-
-# Message files
-MSGFILES=$(wildcard msg/error*.msg)
-
-# ppcSUFFIX
-ifeq ($(PPC_TARGET),i386)
-CPUSUF=386
-endif
-ifeq ($(PPC_TARGET),alpha)
-CPUSUF=axp
-endif
-ifeq ($(PPC_TARGET),m68k)
-CPUSUF=68k
-endif
-ifeq ($(PPC_TARGET),powerpc)
-CPUSUF=ppc
-endif
-ifeq ($(PPC_TARGET),powerpc64)
-CPUSUF=ppc64
-endif
-ifeq ($(PPC_TARGET),sparc)
-CPUSUF=sparc
-endif
-ifeq ($(PPC_TARGET),x86_64)
-CPUSUF=x64
-endif
-ifeq ($(PPC_TARGET),arm)
-CPUSUF=arm
-endif
-
-# Do not define the default -d$(CPU_TARGET) because that
-# will conflict with our -d$(PPC_TARGET)
-NOCPUDEF=1
-
-# Default message file
-MSGFILE=msg/error$(FPCLANG).msg
-
-# Define Unix also for Linux
-ifeq ($(OS_TARGET),linux)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALOPT+=-dUNIX
-endif
-endif
-
-ifeq ($(OS_TARGET),freebsd)
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override LOCALOPT+=-dUNIX
-endif
-endif
-
-# set correct defines (-d$(CPU_TARGET) is automaticly added in makefile.fpc)
-override LOCALOPT+=-d$(PPC_TARGET) -dGDB -dBROWSERLOG
-
-# i386 specific
-ifeq ($(PPC_TARGET),i386)
-override LOCALOPT+=-Fux86
-endif
-
-# x86_64 specific
-ifeq ($(PPC_TARGET),x86_64)
-override LOCALOPT+=-Fux86
-endif
-
-# PowerPC specific
-ifeq ($(PPC_TARGET),powerpc)
-override LOCALOPT+=
-endif
-
-# m68k specific
-ifeq ($(PPC_TARGET),m68k)
-override LOCALOPT+=-dNOOPT
-endif
-
-# Sparc specific
-ifeq ($(PPC_TARGET),sparc)
-override LOCALOPT+=
-endif
-
-# m68k specific with low stack
-ifeq ($(PPC_TARGET),m68k)
-ifeq ($(OS_TARGET),amiga)
-override LOCALOPT+=-Ct
-endif
-endif
-
-# ARM specific
-ifeq ($(PPC_TARGET),arm)
-override LOCALOPT+=-dNOOPT
-endif
-
-[rules]
-#####################################################################
-# Setup Targets
-#####################################################################
-
-ifeq ($(OS_TARGET),win32)
-ifdef CMP
-override DIFF:=$(CMP) -i218
-endif
-endif
-
-# Add Local options
-override COMPILER+=$(LOCALOPT)
-
-# Disable optimizer when compiled with 1.0.x
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-override COMPILER:=$(patsubst -O%,,$(COMPILER))
-endif
-
-
-#####################################################################
-# PASDoc
-#####################################################################
-
-PASDOC:=$(strip $(wildcard $(addsuffix /pasdoc.exe,$(SEARCHPATH))))
-ifeq ($(PASDOC),)
-PASDOC:=$(strip $(wildcard $(addsuffix /pasdoc,$(SEARCHPATH))))
-endif
-ifeq ($(PASDOC),)
-PASDOC:=../projects/pasdoc/bin/pasdoc
-else
-PASDOC:=$(firstword $(PASDOC))
-endif
-
-
-#####################################################################
-# Setup os-independent filenames
-#####################################################################
-
-ifndef EXENAME
-EXENAME=ppc$(CPUSUF)$(EXEEXT)
-endif
-PPEXENAME=pp$(EXEEXT)
-TEMPNAME=ppc$(SRCEXEEXT)
-PPCROSSNAME=ppcross$(CPUSUF)$(SRCEXEEXT)
-TEMPNAME1=ppc1$(EXEEXT)
-TEMPNAME2=ppc2$(EXEEXT)
-TEMPNAME3=ppc3$(EXEEXT)
-MAKEDEP=ppdep$(EXEEXT)
-MSG2INC=./msg2inc$(EXEEXT)
-ifdef CROSSINSTALL
-INSTALLEXEFILE=$(PPCROSSNAME)
-else
-INSTALLEXEFILE=$(EXENAME)
-endif
-
-#####################################################################
-# CPU targets
-#####################################################################
-
-PPC_TARGETS=alpha i386 m68k powerpc sparc arm x86_64
-
-.PHONY: $(PPC_TARGETS)
-
-$(PPC_TARGETS):
-        $(MAKE) PPC_TARGET=$@ CPU_UNITDIR=$@ all
-
-
-#####################################################################
-# Default makefile
-#####################################################################
-
-.PHONY: all compiler echotime ppuclean execlean clean distclean
-
-all: compiler $(addsuffix _all,$(TARGET_DIRS))
-
-compiler: $(COMPILER_UNITTARGETDIR) $(COMPILER_TARGETDIR) $(EXENAME)
-
-ifeq ($(MAKELEVEL),0)
-ifndef STARTTIME
-ifdef DATE
-STARTTIME:=$(shell $(DATE) +%T)
-else
-STARTTIME:=unknown
-endif
-endif
-endif
-
-export STARTTIME
-
-ifdef DATE
-ENDTIME=$(shell $(DATE) +%T)
-else
-ENDTIME:=unknown
-endif
-
-echotime:
-        @echo Start $(STARTTIME) now $(ENDTIME)
-
-ppuclean:
-        -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-        -$(DEL) $(addsuffix /*$(PPUEXT),$(COMPILERSOURCEDIR))
-
-tempclean:
-        -$(DEL) $(PPCROSSNAME) $(TEMPNAME) $(TEMPNAME1) $(TEMPNAME2) $(TEMPNAME3) $(MSG2INC)
-
-execlean :
-        -$(DEL) ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) $(EXENAME)
-
-$(addsuffix _clean,$(ALLTARGETS)):
-        -$(DELTREE) $(addprefix $(subst _clean,,$@),/units)
-        -$(DEL) $(addprefix $(subst _clean,,$@)/,*$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT))
-        -$(DEL) $(addprefix $(subst _clean,,$@)/,ppc386$(EXEEXT) ppcaxp$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcppc$(EXEEXT) $(EXENAME))
-
-cycleclean: cleanall $(addsuffix _clean,$(PPC_TARGET))
-        -$(DEL) $(EXENAME)
-
-clean: tempclean execlean cleanall $(addsuffix _clean,$(PPC_TARGET)) $(addsuffix _clean,$(TARGET_DIRS))
-
-distclean: tempclean execlean cleanall $(addsuffix _clean,$(ALLTARGETS)) $(addsuffix _distclean,$(TARGET_DIRS))
-
-
-#####################################################################
-# Make targets
-#####################################################################
-
-$(MSG2INC): $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(COMPILERUTILSDIR)/msg2inc.pp
-        $(COMPILER) -FE. $(COMPILERUTILSDIR)/msg2inc.pp
-
-# The msgtxt.inc only depends on the error?.msg file, not on msg2inc,
-# because that one will be new almost everytime
-msgtxt.inc: $(MSGFILE)
-        $(MAKE) $(MSG2INC)
-        $(MSG2INC) $(MSGFILE) msg msg
-
-msg: msgtxt.inc
-
-# Make only the compiler
-$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg \
-             $(wildcard systems/*.pas) $(wilcard systems/*.inc) \
-             $(wildcard $(PPC_TARGET)/*.pas) $(wildcard $(PPC_TARGET)/*.inc)
-        $(COMPILER) pp.pas
-        $(EXECPPAS)
-        $(MOVE) $(COMPILER_TARGETDIR)/$(PPEXENAME) $(EXENAME)
-
-
-#####################################################################
-# Cycle targets
-#
-# 1. Source CPU = Target CPU  and  Source OS = Target OS
-#    Normal cycle
-#
-# 2. Source CPU = Target CPU  and  Source OS <> Target OS
-#    First source native compiler
-#    Second target native compiler  (skipped for cross installation)
-#
-# 3. Source CPU <> Target CPU
-#    First source native compiler
-#    Second cross compiler
-#    Third target native compiler (skipped for cross installation)
-#
-#####################################################################
-
-ifeq ($(CPU_SOURCE),$(PPC_TARGET))
-
-ifeq ($(OS_SOURCE),$(OS_TARGET))
-
-##########################
-# Normal cycle
-#
-
-# Used to avoid unnecessary steps
-ifdef DIFF
-ifdef OLDFPC
-DIFFRESULT:=$(shell $(DIFF) $(OLDFPC) $(FPC))
-else
-DIFFRESULT=Not equal
-endif
-else
-DIFFRESULT=No diff program
-endif
-
-ifndef DIFFRESULT
-next :
-        @echo $(OLDFPC) and $(FPC) are equal
-        $(COPY) $(FPC) $(EXENAME)
-else
-next :
-        $(MAKE) rtlclean rtl
-        $(MAKE) cycleclean compiler
-        $(MAKE) echotime
-endif
-
-$(TEMPNAME1) :
-        $(MAKE) 'OLDFPC=' next
-        -$(DEL) $(TEMPNAME1)
-        $(MOVE) $(EXENAME) $(TEMPNAME1)
-
-$(TEMPNAME2) : $(TEMPNAME1)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME1)' 'OLDFPC=' next
-        -$(DEL) $(TEMPNAME2)
-        $(MOVE) $(EXENAME) $(TEMPNAME2)
-
-$(TEMPNAME3) : $(TEMPNAME2)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME2)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME1)' next
-        -$(DEL) $(TEMPNAME3)
-        $(MOVE) $(EXENAME) $(TEMPNAME3)
-
-cycle:
-        $(MAKE) tempclean $(TEMPNAME3)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OLDFPC=$(BASEDIR)/$(TEMPNAME2)' next
-        $(DIFF) $(TEMPNAME3) $(EXENAME)
-        $(MAKE) $(addsuffix _all,$(TARGET_DIRS)) 'FPC=$(BASEDIR)/$(EXENAME)'
-        $(MAKE) echotime
-
-else
-
-##########################
-# Cross Target cycle
-#
-
-cycle:
-# ppc (source native)
-        $(MAKE) OS_TARGET=$(OS_SOURCE) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-        $(MAKE) OS_TARGET=$(OS_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
-# ppcross<ARCH> (source native)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) EXENAME=$(PPCROSSNAME) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
-# ppc<ARCH> (target native)
-ifndef CROSSINSTALL
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler
-endif
-
-endif
-
-else
-
-##########################
-# Cross CPU cycle
-#
-# ppc1 = native
-# ppc2 = cross running on this platform
-# ppc3/ppcXXX = native (skipped for cross installation)
-#
-
-cycle:
-# ppc (source native)
-        $(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-        $(MAKE) OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) EXENAME=$(TEMPNAME) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
-# ppcross<ARCH> (source native)
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 rtlclean rtl
-        $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME)' OS_TARGET=$(OS_SOURCE) CPU_TARGET=$(CPU_SOURCE) PPC_TARGET=$(CPU_TARGET) EXENAME=$(PPCROSSNAME) CROSSBINDIR="" BINUTILSPREFIX="" CROSSCYCLEBOOTSTRAP=1 cycleclean compiler
-# ppc<ARCH> (target native)
-ifndef CROSSINSTALL
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl
-        $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler
-endif
-
-endif
-
-cycledep:
-        $(MAKE) cycle USEDEPEND=1
-
-extcycle:
-        $(MAKE) cycle OPT='-n -OG2p3 -gl -CRriot -dEXTDEBUG'
-
-cvstest:
-        $(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'
-
-
-##########################
-# Full cycle
-#
-# 1. build a compiler using cycle
-# 2. remove all .ppufiles
-# 3. build all supported cross compilers except the
-#    current PPC_TARGET which was already build
-#
-
-full: fullcycle
-
-fullcycle:
-        $(MAKE) cycle
-        $(MAKE) ppuclean
-        $(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAME)'
-
-#####################################################################
-# Docs
-#####################################################################
-
-htmldocs:
-        $(PASDOC) -p -h -o html$(PATHSEP)$(PPC_TARGET) -d fpc -d gdb -d $(PPC_TARGET) -u $(PPC_TARGET) $(PPC_TARGET)$(PATHSEP)*.pas systems$(PATHSEP)*.pas *.pas
-
-#####################################################################
-# Installation
-#####################################################################
-
-.PHONY: quickinstall install installsym
-
-MSGINSTALLDIR=$(INSTALL_BASEDIR)/msg
-override PPEXEFILE:=$(wildcard $(EXENAME))
-
-ifdef UNIXHier
-PPCCPULOCATION=$(INSTALL_BASEDIR)
-else
-PPCCPULOCATION=$(INSTALL_BINDIR)
-endif
-
-# This will only install the ppcXXX executable, not the message files etc.
-quickinstall: $(addsuffix _install,$(TARGET_DIRS))
-# Install ppcXXX executable, for a cross installation we install
-# the ppcrossXXX as ppcXXX. The target native build ppcXXX is not used
-# for this installation type
-ifneq ($(INSTALLEXEFILE),)
-ifdef UPXPROG
-        -$(UPXPROG) $(INSTALLEXEFILE)
-endif
-        $(MKDIR) $(PPCCPULOCATION)
-        $(INSTALLEXE) $(INSTALLEXEFILE) $(PPCCPULOCATION)/$(EXENAME)
-endif
-
-install: quickinstall
-ifndef CROSSINSTALL
-ifdef UNIXHier
-        $(MKDIR) $(INSTALL_BASEDIR)
-        $(INSTALLEXE) $(COMPILERUTILSDIR)/samplecfg $(INSTALL_BASEDIR)/samplecfg
-endif
-        $(MKDIR) $(MSGINSTALLDIR)
-        $(INSTALL) $(MSGFILES) $(MSGINSTALLDIR)
-endif
-
-# This also installs a link from bin to the actual executable.
-# The .deb does that later.
-installsymlink: install
-ifneq ($(PPCCPULOCATION),$(INSTALL_BINDIR))
-        $(MKDIR) $(INSTALL_BINDIR)
-        ln -sf $(INSTALL_BASEDIR)/$(EXENAME) $(INSTALL_BINDIR)/$(EXENAME)
-endif
-
-
-#####################################################################
-# RTL
-#####################################################################
-
-.PHONY: rtl rtlclean rtlinstall
-
-rtl:
-        $(MAKE) -C $(PACKAGEDIR_RTL) 'OPT=$(RTLOPT)' all
-
-rtlclean:
-        $(MAKE) -C $(PACKAGEDIR_RTL) clean
-
-rtlinstall:
-        $(MAKE) -C $(PACKAGEDIR_RTL) install
-
-
-#####################################################################
-# local user configurable file
-# in makefile.loc you can add any desired target
-#####################################################################
-
-localmake:=$(strip $(wildcard makefile.loc))
-
-ifdef localmake
-include ./$(localmake)
-endif

compiler/compiler/README

@@ -1,58 +0,0 @@
-This directory contains the sources of the Free Pascal Compiler
-
-If you want to compile/modify the compiler, please read first the
-programmers manual.
-
-To recompile the compiler, you can use the batch files :
- + mppc386.bat    if you want to build a cross compiler from i386 to m68k
- + mppcsparc      if you want to build a cross compiler from i386 to SPARC
- 
- or
-Use the make utility as following
-  
-      make OS_TARGET="compiler OS target" \
-      CPU_TARGET="compiler CPU target" \
-      FPCCPUOPT="Optimization level" \
-      PP="compiler used to compile FPC" \
-      COMPILER_OPTIONS="Options passed to compiler" \
-      
-      
-If an option is omitted, then target CPU/OS will be same as current CPU/OS
- 
-Possibles targets are : linux go32v2 win32 os2 freebsd beos netbsd amiga
-atari sunos qnx netware openbsd wdosx palmos macos macosx emx
-   
-Possible compiler switches (* marks a currently required switch):
-  -----------------------------------------------------------------
-  GDB*                support of the GNU Debugger
-  I386                generate a compiler for the Intel i386+
-  x86_64              generate a compiler for the AMD x86-64 architecture
-  M68K                generate a compiler for the M68000
-  SPARC               generate a compiler for SPARC
-  POWERPC             generate a compiler for the PowerPC
-  VIS                 generate a compile for the VIS
-  DEBUG               version with debug code is generated
-  EXTDEBUG            some extra debug code is executed
-  SUPPORT_MMX         only i386: releases the compiler switch
-                      MMX which allows the compiler to generate
-                      MMX instructions
-  EXTERN_MSG          Don't compile the msgfiles in the compiler, always
-                      use external messagefiles, default for TP
-  NOAG386INT          no Intel Assembler output
-  NOAG386NSM          no NASM output
-  NOAG386BIN          leaves out the binary writer, default for TP
-  NORA386DIR          No direct i386 assembler reader
-  TEST_GENERIC        Test Generic version of code generator
-                      (uses generic RTL calls)
-  -----------------------------------------------------------------
-  cpuflags            The target processor has status flags (on by default)
-  cpufpemu            The target compiler will also support emitting software
-                       floating point operations
-  cpu64bit            The target is a 64-bit processor
-  -----------------------------------------------------------------
-
-  Required switches for a i386 compiler be compiled by Free Pascal Compiler:
-  GDB;I386
-
-to build a compiler to SPARC target using a Win32/i386 you just use :
-      make CPU_TARGET=SPARC

compiler/compiler/aasmbase.pas

@@ -1,952 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    This unit implements an abstract asmoutput class for all processor types
-
-    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.
-
- ****************************************************************************
-}
-{ @abstract(This unit implements an abstract asm output class for all processor types)
-  This unit implements an abstract assembler output class for all processors, these
-  are then overriden for each assembler writer to actually write the data in these
-  classes to an assembler file.
-}
-
-unit aasmbase;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-       cutils,cclasses,
-       globtype,globals,systems
-       ;
-
-    type
-       TAsmSection = class;
-       TAsmObjectData = class;
-
-       TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);
-
-       TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL);
-
-       TAsmRelocationType = (RELOC_ABSOLUTE,RELOC_RELATIVE,RELOC_RVA);
-
-       TAsmSectionType=(sec_none,
-         sec_code,sec_data,sec_rodata,sec_bss,sec_threadvar,
-         sec_common, { used for executable creation }
-         sec_custom, { custom section, no prefix }
-         sec_stub,   { used for darwin import stubs }
-         { stabs }
-         sec_stab,sec_stabstr,
-         { win32 }
-         sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_edata,
-         { C++ exception handling unwinding (uses dwarf) }
-         sec_eh_frame,
-         { dwarf }
-         sec_debug_frame,
-         { ELF resources }
-         sec_fpc
-       );
-
-       TAsmSectionOption = (aso_alloconly,aso_executable);
-       TAsmSectionOptions = set of TAsmSectionOption;
-
-       TAsmSymbol = class(TNamedIndexItem)
-       private
-         { this need to be incremented with every symbol loading into the
-           paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
-         refs       : longint;
-       public
-         defbind,
-         currbind   : TAsmsymbind;
-         typ        : TAsmsymtype;
-         { the next fields are filled in the binary writer }
-         section    : TAsmSection;
-         address,
-         size       : aint;
-         { Alternate symbol which can be used for 'renaming' needed for
-           inlining }
-         altsymbol  : tasmsymbol;
-         { pointer to objectdata that is the owner of this symbol }
-         owner      : tasmobjectdata;
-         { Is the symbol in the used list }
-         inusedlist : boolean;
-         { assembler pass label is set, used for detecting multiple labels }
-         pass       : byte;
-         ppuidx     : longint;
-         constructor create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
-         procedure reset;
-         function  is_used:boolean;
-         procedure increfs;
-         procedure decrefs;
-         function getrefs: longint;
-         procedure setaddress(_pass:byte;sec:TAsmSection;offset,len:aint);
-       end;
-
-       { is the label only there for getting an address (e.g. for i/o
-         checks -> alt_addr) or is it a jump target (alt_jump), for debug
-         info alt_dbgline and alt_dbgfile }
-       TAsmLabelType = (alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile,alt_dbgtype);
-
-       TAsmLabel = class(TAsmSymbol)
-         labelnr   : longint;
-         labeltype : TAsmLabelType;
-         is_set    : boolean;
-         constructor createlocal(nr:longint;ltyp:TAsmLabelType);
-         constructor createglobal(const modulename:string;nr:longint;ltyp:TAsmLabelType);
-         function getname:string;override;
-       end;
-
-       TAsmRelocation = class(TLinkedListItem)
-          address,
-          orgsize  : aint;  { original size of the symbol to relocate, required for COFF }
-          symbol   : TAsmSymbol;
-          section  : TAsmSection; { only used if symbol=nil }
-          typ      : TAsmRelocationType;
-          constructor CreateSymbol(Aaddress:aint;s:Tasmsymbol;Atyp:TAsmRelocationType);
-          constructor CreateSymbolSize(Aaddress:aint;s:Tasmsymbol;Aorgsize:aint;Atyp:TAsmRelocationType);
-          constructor CreateSection(Aaddress:aint;sec:TAsmSection;Atyp:TAsmRelocationType);
-       end;
-
-       TAsmSection = class(TNamedIndexItem)
-         owner      : TAsmObjectData;
-         secoptions : TAsmSectionOptions;
-         sectype    : TAsmSectionType;
-         secsymidx  : longint;   { index for the section in symtab }
-         addralign  : longint;   { alignment of the section }
-         { size of the data and in the file }
-         dataalignbytes : longint;
-         data      : TDynamicArray;
-         datasize,
-         datapos   : aint;
-         { size and position in memory }
-         memsize,
-         mempos    : aint;
-         { relocation }
-         relocations : TLinkedList;
-         constructor create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);virtual;
-         destructor  destroy;override;
-         function  write(const d;l:aint):aint;
-         function  writestr(const s:string):aint;
-         procedure writealign(l:longint);
-         function  aligneddatasize:aint;
-         procedure setdatapos(var dpos:aint);
-         procedure alignsection;
-         procedure alloc(l:aint);
-         procedure addsymreloc(ofs:aint;p:tasmsymbol;relative:TAsmRelocationType);
-         procedure addsectionreloc(ofs:aint;sec:TAsmSection;relative:TAsmRelocationType);
-         procedure fixuprelocs;virtual;
-       end;
-       TAsmSectionClass = class of TAsmSection;
-
-       TAsmObjectData = class(TLinkedListItem)
-       private
-         FName      : string[80];
-         FCurrSec   : TAsmSection;
-         { Sections will be stored in order in SectsIndex, this is at least
-           required for stabs debuginfo. The SectsDict is only used for lookups (PFV) }
-         FSectsDict   : TDictionary;
-         FSectsIndex  : TIndexArray;
-         FCAsmSection : TAsmSectionClass;
-         { Symbols that will be defined in this object file }
-         FSymbols   : TIndexArray;
-         { Special info sections that are written to during object generation }
-         FStabsRecSize : longint;
-         FStabsSec,
-         FStabStrSec : TAsmSection;
-         procedure section_reset(p:tnamedindexitem;arg:pointer);
-         procedure section_fixuprelocs(p:tnamedindexitem;arg:pointer);
-       protected
-         property StabsRecSize:longint read FStabsRecSize write FStabsRecSize;
-         property StabsSec:TAsmSection read FStabsSec write FStabsSec;
-         property StabStrSec:TAsmSection read FStabStrSec write FStabStrSec;
-         property CAsmSection:TAsmSectionClass read FCAsmSection write FCAsmSection;
-       public
-         constructor create(const n:string);virtual;
-         destructor  destroy;override;
-         function  sectionname(atype:tasmsectiontype;const aname:string):string;virtual;
-         function  createsection(atype:tasmsectiontype;const aname:string;aalign:longint;aoptions:TAsmSectionOptions):tasmsection;virtual;
-         procedure setsection(asec:tasmsection);
-         procedure alloc(len:aint);
-         procedure allocalign(len:longint);
-         procedure allocstab(p:pchar);
-         procedure allocsymbol(currpass:byte;p:tasmsymbol;len:aint);
-         procedure writebytes(var data;len:aint);
-         procedure writereloc(data,len:aint;p:tasmsymbol;relative:TAsmRelocationType);virtual;abstract;
-         procedure writesymbol(p:tasmsymbol);virtual;abstract;
-         procedure writestab(offset:aint;ps:tasmsymbol;nidx,nother,line:longint;p:pchar);virtual;abstract;
-         procedure beforealloc;virtual;
-         procedure beforewrite;virtual;
-         procedure afteralloc;virtual;
-         procedure afterwrite;virtual;
-         procedure resetsections;
-         procedure fixuprelocs;
-         property Name:string[80] read FName;
-         property CurrSec:TAsmSection read FCurrSec;
-         property Symbols:TindexArray read FSymbols;
-         property Sects:TIndexArray read FSectsIndex;
-       end;
-       TAsmObjectDataClass = class of TAsmObjectData;
-
-       tasmsymbolidxarr = array[0..($7fffffff div sizeof(pointer))-1] of tasmsymbol;
-       pasmsymbolidxarr = ^tasmsymbolidxarr;
-
-       TAsmLibraryData = class(TLinkedListItem)
-       private
-         nextaltnr   : longint;
-         nextlabelnr : array[Tasmlabeltype] of longint;
-       public
-         name,
-         realname     : string[80];
-         symbolsearch : tdictionary; { contains ALL assembler symbols }
-         usedasmsymbollist : tsinglelist;
-         { ppu }
-         asmsymbolppuidx : longint;
-         asmsymbolidx : pasmsymbolidxarr; { used for translating ppu index->asmsymbol }
-         constructor create(const n:string);
-         destructor  destroy;override;
-         procedure Freeasmsymbolidx;
-         procedure DerefAsmsymbol(var s:tasmsymbol);
-         { asmsymbol }
-         function  newasmsymbol(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol;
-         function  getasmsymbol(const s : string) : tasmsymbol;
-         function  renameasmsymbol(const sold, snew : string):tasmsymbol;
-         function  newasmlabel(nr:longint;alt:tasmlabeltype;is_global:boolean) : tasmlabel;
-         {# create a new assembler label }
-         procedure getlabel(var l : tasmlabel;alt:tasmlabeltype);
-         {# create a new assembler label for jumps }
-         procedure getjumplabel(var l : tasmlabel);
-         { make l as a new label and flag is_addr }
-         procedure getaddrlabel(var l : tasmlabel);
-         { make l as a new label and flag is_data }
-         procedure getdatalabel(var l : tasmlabel);
-         {# return a label number }
-         procedure CreateUsedAsmSymbolList;
-         procedure DestroyUsedAsmSymbolList;
-         procedure UsedAsmSymbolListInsert(p:tasmsymbol);
-         { generate an alternative (duplicate) symbol }
-         procedure GenerateAltSymbol(p:tasmsymbol);
-         { reset alternative symbol information }
-         procedure UsedAsmSymbolListResetAltSym;
-         procedure UsedAsmSymbolListReset;
-         procedure UsedAsmSymbolListCheckUndefined;
-       end;
-
-    const
-      { alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile }
-      asmlabeltypeprefix : array[tasmlabeltype] of char = ('j','a','d','l','f','t');
-
-    var
-      objectlibrary : tasmlibrarydata;
-
-
-implementation
-
-    uses
-      strings,
-      verbose;
-
-    const
-      sectsgrow   = 100;
-      symbolsgrow = 100;
-
-
-{*****************************************************************************
-                                 TAsmSymbol
-*****************************************************************************}
-
-    constructor tasmsymbol.create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
-      begin;
-        inherited createname(s);
-        reset;
-        defbind:=_bind;
-        typ:=_typ;
-        inusedlist:=false;
-        pass:=255;
-        ppuidx:=-1;
-        { mainly used to remove unused labels from the al_procedures }
-        refs:=0;
-      end;
-
-
-    procedure tasmsymbol.reset;
-      begin
-        { reset section info }
-        section:=nil;
-        address:=0;
-        size:=0;
-        indexnr:=-1;
-        pass:=255;
-        currbind:=AB_EXTERNAL;
-        altsymbol:=nil;
-{        taiowner:=nil;}
-      end;
-
-
-    function tasmsymbol.is_used:boolean;
-      begin
-        is_used:=(refs>0);
-      end;
-
-
-    procedure tasmsymbol.increfs;
-      begin
-        inc(refs);
-      end;
-
-
-    procedure tasmsymbol.decrefs;
-      begin
-        dec(refs);
-        if refs<0 then
-          internalerror(200211121);
-      end;
-
-
-    function tasmsymbol.getrefs: longint;
-      begin
-        getrefs := refs;
-      end;
-
-
-    procedure tasmsymbol.setaddress(_pass:byte;sec:TAsmSection;offset,len:aint);
-      begin
-        if (_pass=pass) then
-         begin
-           Message1(asmw_e_duplicate_label,name);
-           exit;
-         end;
-        pass:=_pass;
-        section:=sec;
-        address:=offset;
-        size:=len;
-        { when the bind was reset to External, set it back to the default
-          bind it got when defined }
-        if (currbind=AB_EXTERNAL) and (defbind<>AB_NONE) then
-         currbind:=defbind;
-      end;
-
-
-{*****************************************************************************
-                                 TAsmLabel
-*****************************************************************************}
-
-    constructor tasmlabel.createlocal(nr:longint;ltyp:TAsmLabelType);
-      begin;
-        inherited create(target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,AT_LABEL);
-        labelnr:=nr;
-        labeltype:=ltyp;
-        is_set:=false;
-      end;
-
-
-    constructor tasmlabel.createglobal(const modulename:string;nr:longint;ltyp:TAsmLabelType);
-      begin;
-        inherited create('_$'+modulename+'$_L'+asmlabeltypeprefix[ltyp]+tostr(nr),AB_GLOBAL,AT_DATA);
-        labelnr:=nr;
-        labeltype:=ltyp;
-        is_set:=false;
-        { write it always }
-        increfs;
-      end;
-
-
-    function tasmlabel.getname:string;
-      begin
-        getname:=inherited getname;
-        increfs;
-      end;
-
-
-{****************************************************************************
-                              TAsmRelocation
-****************************************************************************}
-
-    constructor TAsmRelocation.CreateSymbol(Aaddress:aint;s:Tasmsymbol;Atyp:TAsmRelocationType);
-      begin
-        Address:=Aaddress;
-        Symbol:=s;
-        OrgSize:=0;
-        Section:=nil;
-        Typ:=Atyp;
-      end;
-
-
-    constructor TAsmRelocation.CreateSymbolSize(Aaddress:aint;s:Tasmsymbol;Aorgsize:aint;Atyp:TAsmRelocationType);
-      begin
-        Address:=Aaddress;
-        Symbol:=s;
-        OrgSize:=Aorgsize;
-        Section:=nil;
-        Typ:=Atyp;
-      end;
-
-
-    constructor TAsmRelocation.CreateSection(Aaddress:aint;sec:TAsmSection;Atyp:TAsmRelocationType);
-      begin
-        Address:=Aaddress;
-        Symbol:=nil;
-        OrgSize:=0;
-        Section:=sec;
-        Typ:=Atyp;
-      end;
-
-
-{****************************************************************************
-                              TAsmSection
-****************************************************************************}
-
-    constructor TAsmSection.create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);
-      begin
-        inherited createname(Aname);
-        sectype:=Atype;
-        name:=Aname;
-        secoptions:=Aoptions;
-        secsymidx:=0;
-        addralign:=Aalign;
-        { data }
-        datasize:=0;
-        datapos:=0;
-        if (aso_alloconly in aoptions) then
-         data:=nil
-        else
-         Data:=TDynamicArray.Create(8192);
-        { memory }
-        mempos:=0;
-        memsize:=0;
-        { relocation }
-        relocations:=TLinkedList.Create;
-      end;
-
-
-    destructor TAsmSection.destroy;
-      begin
-        if assigned(Data) then
-          Data.Free;
-        relocations.free;
-      end;
-
-
-    function TAsmSection.write(const d;l:aint):aint;
-      begin
-        write:=datasize;
-        if assigned(Data) then
-          Data.write(d,l);
-        inc(datasize,l);
-      end;
-
-
-    function TAsmSection.writestr(const s:string):aint;
-      begin
-        writestr:=datasize;
-        if assigned(Data) then
-          Data.write(s[1],length(s));
-        inc(datasize,length(s));
-      end;
-
-
-    procedure TAsmSection.writealign(l:longint);
-      var
-        i : longint;
-        empty : array[0..63] of char;
-      begin
-        { no alignment needed for 0 or 1 }
-        if l<=1 then
-         exit;
-        i:=datasize mod l;
-        if i>0 then
-         begin
-           if assigned(data) then
-            begin
-              fillchar(empty,sizeof(empty),0);
-              Data.write(empty,l-i);
-            end;
-           inc(datasize,l-i);
-         end;
-      end;
-
-
-    function TAsmSection.aligneddatasize:aint;
-      begin
-        aligneddatasize:=align(datasize,addralign);
-      end;
-
-
-    procedure TAsmSection.setdatapos(var dpos:aint);
-      var
-        alignedpos : aint;
-      begin
-        { get aligned datapos }
-        alignedpos:=align(dpos,addralign);
-        dataalignbytes:=alignedpos-dpos;
-        datapos:=alignedpos;
-        { update datapos }
-        dpos:=datapos+aligneddatasize;
-      end;
-
-
-    procedure TAsmSection.alignsection;
-      begin
-        writealign(addralign);
-      end;
-
-
-    procedure TAsmSection.alloc(l:aint);
-      begin
-        inc(datasize,l);
-      end;
-
-
-    procedure TAsmSection.addsymreloc(ofs:aint;p:tasmsymbol;relative:TAsmRelocationType);
-      var
-        r : TAsmRelocation;
-      begin
-        r:=TAsmRelocation.Create;
-        r.address:=ofs;
-        r.orgsize:=0;
-        r.symbol:=p;
-        r.section:=nil;
-        r.typ:=relative;
-        relocations.concat(r);
-      end;
-
-
-    procedure TAsmSection.addsectionreloc(ofs:aint;sec:TAsmSection;relative:TAsmRelocationType);
-      var
-        r : TAsmRelocation;
-      begin
-        r:=TAsmRelocation.Create;
-        r.address:=ofs;
-        r.symbol:=nil;
-        r.orgsize:=0;
-        r.section:=sec;
-        r.typ:=relative;
-        relocations.concat(r);
-      end;
-
-
-    procedure TAsmSection.fixuprelocs;
-      begin
-      end;
-
-
-{****************************************************************************
-                                TAsmObjectData
-****************************************************************************}
-
-    constructor TAsmObjectData.create(const n:string);
-      begin
-        inherited create;
-        FName:=n;
-        { sections, the SectsIndex owns the items, the FSectsDict
-          is only used for lookups }
-        FSectsDict:=tdictionary.create;
-        FSectsDict.noclear:=true;
-        FSectsIndex:=tindexarray.create(sectsgrow);
-        FStabsRecSize:=1;
-        FStabsSec:=nil;
-        FStabStrSec:=nil;
-        { symbols }
-        FSymbols:=tindexarray.create(symbolsgrow);
-        FSymbols.noclear:=true;
-        { section class type for creating of new sections }
-        FCAsmSection:=TAsmSection;
-      end;
-
-
-    destructor TAsmObjectData.destroy;
-      begin
-        FSectsDict.free;
-        FSectsIndex.free;
-        FSymbols.free;
-      end;
-
-
-    function TAsmObjectData.sectionname(atype:tasmsectiontype;const aname:string):string;
-      const
-        secnames : array[tasmsectiontype] of string[12] = ('',
-          'code','data','rodata','bss','threadvar',
-          'common',
-          'note',
-          'text',
-          'stab','stabstr',
-          'idata2','idata4','idata5','idata6','idata7','edata',
-          'eh_frame',
-          'debug_frame',
-          'fpc'
-        );
-      begin
-        if aname<>'' then
-          result:=secnames[atype]+'.'+aname
-        else
-          result:=secnames[atype];
-      end;
-
-
-    function TAsmObjectData.createsection(atype:tasmsectiontype;const aname:string;aalign:longint;aoptions:TAsmSectionOptions):TAsmSection;
-      var
-        secname : string;
-      begin
-        secname:=sectionname(atype,aname);
-        result:=TasmSection(FSectsDict.search(secname));
-        if not assigned(result) then
-          begin
-{$warning TODO make alloconly configurable}
-            if atype=sec_bss then
-              include(aoptions,aso_alloconly);
-            result:=CAsmSection.create(secname,atype,aalign,aoptions);
-            FSectsDict.Insert(result);
-            FSectsIndex.Insert(result);
-            result.owner:=self;
-          end;
-        FCurrSec:=result;
-      end;
-
-
-    procedure TAsmObjectData.setsection(asec:tasmsection);
-      begin
-        if asec.owner<>self then
-          internalerror(200403041);
-        FCurrSec:=asec;
-      end;
-
-
-    procedure TAsmObjectData.writebytes(var data;len:aint);
-      begin
-        if not assigned(currsec) then
-          internalerror(200402251);
-        currsec.write(data,len);
-      end;
-
-
-    procedure TAsmObjectData.alloc(len:aint);
-      begin
-        if not assigned(currsec) then
-          internalerror(200402252);
-        currsec.alloc(len);
-      end;
-
-
-    procedure TAsmObjectData.allocalign(len:longint);
-      var
-        modulo : aint;
-      begin
-        if not assigned(currsec) then
-          internalerror(200402253);
-        modulo:=currsec.datasize mod len;
-        if modulo > 0 then
-          currsec.alloc(len-modulo);
-      end;
-
-
-    procedure TAsmObjectData.allocsymbol(currpass:byte;p:tasmsymbol;len:aint);
-      begin
-        p.setaddress(currpass,currsec,currsec.datasize,len);
-      end;
-
-
-    procedure TAsmObjectData.allocstab(p:pchar);
-      begin
-        if not(assigned(FStabsSec) and assigned(FStabStrSec)) then
-          internalerror(200402254);
-        FStabsSec.alloc(FStabsRecSize);
-        if assigned(p) and (p[0]<>#0) then
-          FStabStrSec.alloc(strlen(p)+1);
-      end;
-
-
-    procedure TAsmObjectData.section_reset(p:tnamedindexitem;arg:pointer);
-      begin
-        with tasmsection(p) do
-          begin
-            datasize:=0;
-            datapos:=0;
-          end;
-      end;
-
-
-    procedure TAsmObjectData.section_fixuprelocs(p:tnamedindexitem;arg:pointer);
-      begin
-        tasmsection(p).fixuprelocs;
-      end;
-
-
-    procedure TAsmObjectData.beforealloc;
-      begin
-      end;
-
-
-    procedure TAsmObjectData.beforewrite;
-      begin
-      end;
-
-
-    procedure TAsmObjectData.afteralloc;
-      begin
-      end;
-
-
-    procedure TAsmObjectData.afterwrite;
-      begin
-      end;
-
-
-    procedure TAsmObjectData.resetsections;
-      begin
-        FSectsDict.foreach(@section_reset,nil);
-      end;
-
-
-    procedure TAsmObjectData.fixuprelocs;
-      begin
-        FSectsDict.foreach(@section_fixuprelocs,nil);
-      end;
-
-
-{****************************************************************************
-                                TAsmLibraryData
-****************************************************************************}
-
-    constructor TAsmLibraryData.create(const n:string);
-      var
-        alt : TAsmLabelType;
-      begin
-        inherited create;
-        realname:=n;
-        name:=upper(n);
-        { symbols }
-        symbolsearch:=tdictionary.create;
-        symbolsearch.usehash;
-        { labels }
-        nextaltnr:=1;
-        for alt:=low(TAsmLabelType) to high(TAsmLabelType) do
-          nextlabelnr[alt]:=1;
-        { ppu }
-        asmsymbolppuidx:=0;
-        asmsymbolidx:=nil;
-      end;
-
-
-    destructor TAsmLibraryData.destroy;
-      begin
-        symbolsearch.free;
-        Freeasmsymbolidx;
-      end;
-
-
-    procedure TAsmLibraryData.Freeasmsymbolidx;
-      begin
-        if assigned(asmsymbolidx) then
-         begin
-           Freemem(asmsymbolidx);
-           asmsymbolidx:=nil;
-         end;
-      end;
-
-
-    procedure TAsmLibraryData.DerefAsmsymbol(var s:tasmsymbol);
-      begin
-        if assigned(s) then
-         begin
-           if not assigned(asmsymbolidx) then
-             internalerror(200208072);
-           if (ptrint(pointer(s))<1) or (ptrint(pointer(s))>asmsymbolppuidx) then
-             internalerror(200208073);
-           s:=asmsymbolidx^[ptrint(pointer(s))-1];
-         end;
-      end;
-
-
-    function TAsmLibraryData.newasmsymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : tasmsymbol;
-      var
-        hp : tasmsymbol;
-      begin
-        hp:=tasmsymbol(symbolsearch.search(s));
-        if assigned(hp) then
-         begin
-           {$IFDEF EXTDEBUG}
-           if (_typ <> AT_NONE) and
-              (hp.typ <> _typ) and
-              not(cs_compilesystem in aktmoduleswitches) then
-             begin
-               //Writeln('Error symbol '+hp.name+' type is ',Ord(_typ),', should be ',Ord(hp.typ));
-               InternalError(2004031501);
-             end;
-           {$ENDIF}
-           if (_bind<>AB_EXTERNAL) then
-             hp.defbind:=_bind
-         end
-        else
-         begin
-           { Not found, insert it. }
-           hp:=tasmsymbol.create(s,_bind,_typ);
-           symbolsearch.insert(hp);
-         end;
-        newasmsymbol:=hp;
-      end;
-
-
-    function TAsmLibraryData.getasmsymbol(const s : string) : tasmsymbol;
-      begin
-        getasmsymbol:=tasmsymbol(symbolsearch.search(s));
-      end;
-
-
-    function TAsmLibraryData.renameasmsymbol(const sold, snew : string):tasmsymbol;
-      begin
-        renameasmsymbol:=tasmsymbol(symbolsearch.rename(sold,snew));
-      end;
-
-
-    procedure TAsmLibraryData.CreateUsedAsmSymbolList;
-      begin
-        if assigned(usedasmsymbollist) then
-         internalerror(78455782);
-        usedasmsymbollist:=TSingleList.create;
-      end;
-
-
-    procedure TAsmLibraryData.DestroyUsedAsmSymbolList;
-      begin
-        usedasmsymbollist.destroy;
-        usedasmsymbollist:=nil;
-      end;
-
-
-    procedure TAsmLibraryData.UsedAsmSymbolListInsert(p:tasmsymbol);
-      begin
-        if not p.inusedlist then
-         usedasmsymbollist.insert(p);
-        p.inusedlist:=true;
-      end;
-
-
-    procedure TAsmLibraryData.GenerateAltSymbol(p:tasmsymbol);
-      begin
-        if not assigned(p.altsymbol) then
-         begin
-           p.altsymbol:=tasmsymbol.create(p.name+'_'+tostr(nextaltnr),p.defbind,p.typ);
-           symbolsearch.insert(p.altsymbol);
-           { add also the original sym to the usedasmsymbollist,
-             that list is used to reset the altsymbol }
-           if not p.inusedlist then
-            usedasmsymbollist.insert(p);
-           p.inusedlist:=true;
-         end;
-      end;
-
-
-    procedure TAsmLibraryData.UsedAsmSymbolListReset;
-      var
-        hp : tasmsymbol;
-      begin
-        hp:=tasmsymbol(usedasmsymbollist.first);
-        while assigned(hp) do
-         begin
-           with hp do
-            begin
-              reset;
-              inusedlist:=false;
-            end;
-           hp:=tasmsymbol(hp.listnext);
-         end;
-      end;
-
-
-    procedure TAsmLibraryData.UsedAsmSymbolListResetAltSym;
-      var
-        hp : tasmsymbol;
-      begin
-        hp:=tasmsymbol(usedasmsymbollist.first);
-        inc(nextaltnr);
-        while assigned(hp) do
-         begin
-           with hp do
-            begin
-              altsymbol:=nil;
-              inusedlist:=false;
-            end;
-           hp:=tasmsymbol(hp.listnext);
-         end;
-      end;
-
-
-    procedure TAsmLibraryData.UsedAsmSymbolListCheckUndefined;
-      var
-        hp : tasmsymbol;
-      begin
-        hp:=tasmsymbol(usedasmsymbollist.first);
-        while assigned(hp) do
-         begin
-           with hp do
-            begin
-              if is_used and
-                 (section=nil) and
-                 not(currbind in [AB_EXTERNAL,AB_COMMON]) then
-               Message1(asmw_e_undefined_label,name);
-            end;
-           hp:=tasmsymbol(hp.listnext);
-         end;
-      end;
-
-
-    function  TAsmLibraryData.newasmlabel(nr:longint;alt:tasmlabeltype;is_global:boolean) : tasmlabel;
-      var
-        hp : tasmlabel;
-      begin
-        if is_global then
-         hp:=tasmlabel.createglobal(name,nr,alt)
-       else
-         hp:=tasmlabel.createlocal(nr,alt);
-        symbolsearch.insert(hp);
-        newasmlabel:=hp;
-      end;
-
-
-    procedure TAsmLibraryData.getlabel(var l : tasmlabel;alt:tasmlabeltype);
-      begin
-        l:=tasmlabel.createlocal(nextlabelnr[alt],alt);
-        inc(nextlabelnr[alt]);
-        symbolsearch.insert(l);
-      end;
-
-    procedure TAsmLibraryData.getjumplabel(var l : tasmlabel);
-      begin
-        l:=tasmlabel.createlocal(nextlabelnr[alt_jump],alt_jump);
-        inc(nextlabelnr[alt_jump]);
-        symbolsearch.insert(l);
-      end;
-
-
-    procedure TAsmLibraryData.getdatalabel(var l : tasmlabel);
-      begin
-        l:=tasmlabel.createglobal(name,nextlabelnr[alt_data],alt_data);
-        inc(nextlabelnr[alt_data]);
-        symbolsearch.insert(l);
-      end;
-
-
-    procedure TAsmLibraryData.getaddrlabel(var l : tasmlabel);
-      begin
-        l:=tasmlabel.createlocal(nextlabelnr[alt_addr],alt_addr);
-        inc(nextlabelnr[alt_addr]);
-        symbolsearch.insert(l);
-      end;
-
-
-end.

compiler/compiler/aasmtai.pas

@@ -1,2349 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    This unit implements an abstract asmoutput class for all processor types
-
-    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.
-
- ****************************************************************************
-}
-{ @abstract(This unit implements an abstract asm output class for all processor types)
-  This unit implements an abstract assembler output class for all processors, these
-  are then overriden for each assembler writer to actually write the data in these
-  classes to an assembler file.
-}
-
-unit aasmtai;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-       cutils,cclasses,
-       globtype,globals,systems,
-       cpuinfo,cpubase,
-       cgbase,cgutils,
-       symtype,
-       aasmbase;
-
-    type
-       taitype = (
-          ait_none,
-          ait_align,
-          ait_section,
-          ait_comment,
-          ait_string,
-          ait_instruction,
-          ait_datablock,
-          ait_symbol,
-          ait_symbol_end, { needed to calc the size of a symbol }
-          ait_directive,
-          ait_label,
-          { the const_xx must be below each other so it can be used as
-            array index }
-          ait_const_128bit,
-          ait_const_64bit,
-          ait_const_32bit,
-          ait_const_16bit,
-          ait_const_8bit,
-          ait_const_sleb128bit,
-          ait_const_uleb128bit,
-          ait_const_rva_symbol, { win32 only }
-          ait_const_indirect_symbol, { darwin only }
-          ait_real_32bit,
-          ait_real_64bit,
-          ait_real_80bit,
-          ait_comp_64bit,
-          ait_real_128bit,
-          ait_stab,
-          ait_force_line,
-          ait_function_name,
-{$ifdef alpha}
-          { the follow is for the DEC Alpha }
-          ait_frame,
-          ait_ent,
-{$endif alpha}
-{$ifdef ia64}
-          ait_bundle,
-          ait_stop,
-{$endif ia64}
-{$ifdef m68k}
-          ait_labeled_instruction,
-{$endif m68k}
-          { used to split into tiny assembler files }
-          ait_cutobject,
-          ait_regalloc,
-          ait_tempalloc,
-          { used to mark assembler blocks and inlined functions }
-          ait_marker
-          );
-
-    const
-{$ifdef cpu64bit}
-       ait_const_aint = ait_const_64bit;
-       ait_const_ptr  = ait_const_64bit;
-{$else cpu64bit}
-       ait_const_aint = ait_const_32bit;
-       ait_const_ptr  = ait_const_32bit;
-{$endif cpu64bit}
-
-       taitypestr : array[taitype] of string[24] = (
-          '<none>',
-          'align',
-          'section',
-          'comment',
-          'string',
-          'instruction',
-          'datablock',
-          'symbol',
-          'symbol_end',
-          'symbol_directive',
-          'label',
-          'const_128bit',
-          'const_64bit',
-          'const_32bit',
-          'const_16bit',
-          'const_8bit',
-          'const_sleb128bit',
-          'const_uleb128bit',
-          'const_rva_symbol',
-          'const_indirect_symbol',
-          'real_32bit',
-          'real_64bit',
-          'real_80bit',
-          'comp_64bit',
-          'real_128bit',
-          'stab',
-          'force_line',
-          'function_name',
-{$ifdef alpha}
-          { the follow is for the DEC Alpha }
-          'frame',
-          'ent',
-{$endif alpha}
-{$ifdef ia64}
-          'bundle',
-          'stop',
-{$endif ia64}
-{$ifdef m68k}
-          'labeled_instr',
-{$endif m68k}
-          'cut',
-          'regalloc',
-          'tempalloc',
-          'marker'
-          );
-
-    type
-      { Types of operand }
-      toptype=(top_none,top_reg,top_ref,top_const,top_bool,top_local
-{$ifdef arm}
-       { ARM only }
-       ,top_regset
-       ,top_shifterop
-{$endif arm}
-{$ifdef m68k}
-       { m68k only }
-       ,top_regset
-{$endif m68k}
-       { i386 only});
-
-      { kinds of operations that an instruction can perform on an operand }
-      topertype = (operand_read,operand_write,operand_readwrite);
-
-      tlocaloper = record
-        localsym : pointer;
-        localsymderef : tderef;
-        localsymofs : longint;
-        localindexreg : tregister;
-        localscale : byte;
-        localgetoffset,
-        localforceref : boolean
-      end;
-      plocaloper = ^tlocaloper;
-
-      { please keep the size of this record <=12 bytes and keep it properly aligned }
-      toper = record
-        ot : longint;
-        case typ : toptype of
-          top_none   : ();
-          top_reg    : (reg:tregister);
-          top_ref    : (ref:preference);
-          top_const  : (val:aint);
-          top_bool   : (b:boolean);
-          { local varsym that will be inserted in pass_2 }
-          top_local  : (localoper:plocaloper);
-      {$ifdef arm}
-          top_regset : (regset:^tcpuregisterset);
-          top_shifterop : (shifterop : pshifterop);
-      {$endif arm}
-      {$ifdef m68k}
-          top_regset : (regset:^tcpuregisterset);
-      {$endif m68k}
-      end;
-      poper=^toper;
-
-{ ait_* types which don't result in executable code or which don't influence   }
-{ the way the program runs/behaves, but which may be encountered by the        }
-{ optimizer (= if it's sometimes added to the exprasm list). Update if you add }
-{ a new ait type!                                                              }
-    const
-      SkipInstr = [ait_comment, ait_symbol,ait_section
-                   ,ait_stab, ait_function_name, ait_force_line
-                   ,ait_regalloc, ait_tempalloc, ait_symbol_end, ait_directive];
-
-{ ait_* types which do not have line information (and hence which are of type
-  tai, otherwise, they are of type tailineinfo }
-      SkipLineInfo =[ait_label,
-                     ait_regalloc,ait_tempalloc,
-                     ait_stab,ait_function_name,
-                     ait_cutobject,ait_marker,ait_align,ait_section,ait_comment,
-                     ait_const_8bit,ait_const_16bit,ait_const_32bit,ait_const_64bit,ait_const_128bit,
-                     ait_const_sleb128bit,ait_const_uleb128bit,
-                     ait_const_rva_symbol,ait_const_indirect_symbol,
-                     ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit
-                    ];
-
-
-    type
-       { cut type, required for alphanumeric ordering of the assembler filenames }
-       TCutPlace=(cut_normal,cut_begin,cut_end);
-
-       TRegAllocType = (ra_alloc,ra_dealloc,ra_sync,ra_resize);
-
-       TMarker = (NoPropInfoStart,NoPropInfoEnd,
-                  AsmBlockStart,AsmBlockEnd,
-                  InlineStart,InlineEnd,marker_blockstart,
-                  marker_position);
-
-       { Buffer type used for alignment }
-       tfillbuffer = array[0..63] of char;
-
-       Tspill_temp_list=array[tsuperregister] of Treference;
-
-       { abstract assembler item }
-       tai = class(TLinkedListItem)
-{$ifndef NOOPT}
-          { pointer to record with optimizer info about this tai object }
-          optinfo  : pointer;
-{$endif NOOPT}
-          typ      : taitype;
-          constructor Create;
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);virtual;
-          procedure ppuwrite(ppufile:tcompilerppufile);virtual;
-          procedure buildderefimpl;virtual;
-          procedure derefimpl;virtual;
-       end;
-
-       { abstract assembler item with line information }
-       tailineinfo = class(tai)
-        fileinfo : tfileposinfo;
-        constructor Create;
-        constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-        procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-       tai_simple = class(tai)
-         constructor create(_typ : taitype);
-       end;
-
-       taiclass = class of tai;
-
-       taiclassarray = array[taitype] of taiclass;
-
-       { Generates an assembler string }
-       tai_string = class(tailineinfo)
-          str : pchar;
-          { extra len so the string can contain an \0 }
-          len : longint;
-          constructor Create(const _str : string);
-          constructor Create_pchar(_str : pchar;length : longint);
-          destructor Destroy;override;
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function getcopy:tlinkedlistitem;override;
-       end;
-
-       { Generates a common label }
-       tai_symbol = class(tailineinfo)
-          is_global : boolean;
-          sym       : tasmsymbol;
-          size      : longint;
-          constructor Create(_sym:tasmsymbol;siz:longint);
-          constructor Create_Global(_sym:tasmsymbol;siz:longint);
-          constructor Createname(const _name : string;_symtyp:Tasmsymtype;siz:longint);
-          constructor Createname_global(const _name : string;_symtyp:Tasmsymtype;siz:longint);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure derefimpl;override;
-       end;
-
-       tai_symbol_end = class(tailineinfo)
-          sym : tasmsymbol;
-          constructor Create(_sym:tasmsymbol);
-          constructor Createname(const _name : string);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure derefimpl;override;
-       end;
-
-       tasmdirective=(asd_non_lazy_symbol_pointer,asd_indirect_symbol,asd_lazy_symbol_pointer,
-                      asd_extern,asd_nasm_import);
-
-       tai_directive = class(tailineinfo)
-          name : pstring;
-          directive : tasmdirective;
-          constructor Create(_directive:tasmdirective;const _name:string);
-          destructor Destroy;override;
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-       { Generates an assembler label }
-       tai_label = class(tai)
-          is_global : boolean;
-          l         : tasmlabel;
-          constructor Create(_l : tasmlabel);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure derefimpl;override;
-       end;
-
-       { Generates an assembler comment }
-       tai_comment = class(tai)
-          str : pchar;
-          constructor Create(_str : pchar);
-          destructor Destroy; override;
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function getcopy:tlinkedlistitem;override;
-       end;
-
-
-       { Generates a section / segment directive }
-       tai_section = class(tai)
-          sectype : TAsmSectionType;
-          secalign : byte;
-          name    : pstring;
-          sec     : TAsmSection; { used in binary writer }
-          constructor Create(Asectype:TAsmSectionType;Aname:string;Aalign:byte);
-          destructor Destroy;override;
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-
-       { Generates an uninitializised data block }
-       tai_datablock = class(tailineinfo)
-          is_global : boolean;
-          sym       : tasmsymbol;
-          size      : longint;
-          constructor Create(const _name : string;_size : longint);
-          constructor Create_global(const _name : string;_size : longint);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure derefimpl;override;
-       end;
-
-
-       { Generates an integer const }
-       tai_const = class(tai)
-          sym,
-          endsym  : tasmsymbol;
-          value   : int64;
-          { we use for the 128bit int64/qword for now because I can't imagine a
-            case where we need 128 bit now (FK) }
-          constructor Create(_typ:taitype;_value : int64);
-          constructor Create_128bit(_value : int64);
-          constructor Create_64bit(_value : int64);
-          constructor Create_32bit(_value : longint);
-          constructor Create_16bit(_value : word);
-          constructor Create_8bit(_value : byte);
-          constructor Create_sleb128bit(_value : int64);
-          constructor Create_uleb128bit(_value : qword);
-          constructor Create_aint(_value : aint);
-          constructor Create_sym(_sym:tasmsymbol);
-          constructor Create_sym_offset(_sym:tasmsymbol;ofs:aint);
-          constructor Create_rel_sym(_typ:taitype;_sym,_endsym:tasmsymbol);
-          constructor Create_rva_sym(_sym:tasmsymbol);
-          constructor Create_indirect_sym(_sym:tasmsymbol);
-          constructor Createname(const name:string;_symtyp:Tasmsymtype;ofs:aint);
-          constructor Createname_rva(const name:string);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure derefimpl;override;
-          function getcopy:tlinkedlistitem;override;
-          function size:longint;
-       end;
-
-       { Generates a single float (32 bit real) }
-       tai_real_32bit = class(tai)
-          value : ts32real;
-          constructor Create(_value : ts32real);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-       tformatoptions = (fo_none,fo_hiloswapped);
-
-       { Generates a double float (64 bit real) }
-       tai_real_64bit = class(tai)
-          value : ts64real;
-{$ifdef ARM}
-          formatoptions : tformatoptions;
-          constructor Create_hiloswapped(_value : ts64real);
-{$endif ARM}
-          constructor Create(_value : ts64real);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-
-       { Generates an extended float (80 bit real) }
-       tai_real_80bit = class(tai)
-          value : ts80real;
-          constructor Create(_value : ts80real);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-
-       { Generates an float128 (128 bit real) }
-       tai_real_128bit = class(tai)
-          value : ts128real;
-          constructor Create(_value : ts128real);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-       { Generates a comp int (integer over 64 bits)
-
-          This is Intel 80x86 specific, and is not
-          really supported on other processors.
-       }
-       tai_comp_64bit = class(tai)
-          value : ts64comp;
-          constructor Create(_value : ts64comp);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-       tstabtype = (stab_stabs,stab_stabn,stab_stabd);
-
-       tai_stab = class(tai)
-          str : pchar;
-          stabtype : tstabtype;
-          constructor Create(_stabtype:tstabtype;_str : pchar);
-          constructor Create_str(_stabtype:tstabtype;const s:string);
-          destructor Destroy;override;
-       end;
-
-       tai_force_line = class(tailineinfo)
-          constructor Create;
-       end;
-
-       tai_function_name = class(tai)
-          funcname : pstring;
-          constructor create(const s:string);
-          destructor destroy;override;
-       end;
-
-       { Insert a cut to split assembler into several smaller files }
-       tai_cutobject = class(tai)
-          place : tcutplace;
-          constructor Create;
-          constructor Create_begin;
-          constructor Create_end;
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-       { Insert a marker for assembler and inline blocks }
-       tai_marker = class(tai)
-          Kind: TMarker;
-          Constructor Create(_Kind: TMarker);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-       tai_tempalloc = class(tai)
-          allocation : boolean;
-{$ifdef EXTDEBUG}
-          problem : pstring;
-{$endif EXTDEBUG}
-          temppos,
-          tempsize   : longint;
-          constructor alloc(pos,size:longint);
-          constructor dealloc(pos,size:longint);
-{$ifdef EXTDEBUG}
-          constructor allocinfo(pos,size:longint;const st:string);
-{$endif EXTDEBUG}
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          destructor destroy;override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-       tai_regalloc = class(tai)
-          reg     : tregister;
-          ratype  : TRegAllocType;
-          { reg(de)alloc belongs to this instruction, this
-            is only used for automatic inserted (de)alloc for
-            imaginary register and required for spilling code }
-          instr   : tai;
-          constructor alloc(r : tregister;ainstr:tai);
-          constructor dealloc(r : tregister;ainstr:tai);
-          constructor sync(r : tregister);
-          constructor resize(r : tregister);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-      Taasmoutput=class;
-
-      tadd_reg_instruction_proc=procedure(instr:Tai;r:tregister) of object;
-      Trggetproc=procedure(list:Taasmoutput;position:Tai;subreg:Tsubregister;var result:Tregister) of object;
-      Trgungetproc=procedure(list:Taasmoutput;position:Tai;r:Tregister) of object;
-
-       { Class template for assembler instructions
-       }
-       tai_cpu_abstract = class(tailineinfo)
-       protected
-          procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual;abstract;
-          procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual;abstract;
-          procedure ppubuildderefimploper(var o:toper);virtual;abstract;
-          procedure ppuderefoper(var o:toper);virtual;abstract;
-       public
-          { Condition flags for instruction }
-          condition : TAsmCond;
-          { Number of operands to instruction }
-          ops       : byte;
-          { Number of allocate oper structures }
-          opercnt   : byte;
-          { Operands of instruction }
-          oper      : array[0..max_operands-1] of poper;
-          { Actual opcode of instruction }
-          opcode    : tasmop;
-{$ifdef x86}
-          segprefix : tregister;
-{$endif x86}
-          { true if instruction is a jmp }
-          is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
-          Constructor Create(op : tasmop);virtual;
-          Destructor Destroy;override;
-          function getcopy:TLinkedListItem;override;
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          procedure buildderefimpl;override;
-          procedure derefimpl;override;
-          procedure SetCondition(const c:TAsmCond);
-          procedure allocate_oper(opers:longint);
-          procedure loadconst(opidx:longint;l:aint);
-          procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
-          procedure loadlocal(opidx:longint;s:pointer;sofs:longint;indexreg:tregister;scale:byte;getoffset,forceref:boolean);
-          procedure loadref(opidx:longint;const r:treference);
-          procedure loadreg(opidx:longint;r:tregister);
-          procedure loadoper(opidx:longint;o:toper);
-          procedure clearop(opidx:longint);
-          { register allocator }
-          function is_same_reg_move(regtype: Tregistertype):boolean;virtual;
-          function spilling_get_operation_type(opnr: longint): topertype;virtual;
-          function spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;virtual;
-
-          function  Pass1(offset:longint):longint;virtual;abstract;
-          procedure Pass2(objdata:TAsmObjectdata);virtual;abstract;
-       end;
-       tai_cpu_class = class of tai_cpu_abstract;
-
-       { alignment for operator }
-       tai_align_abstract = class(tai)
-          aligntype : byte;   { 1 = no align, 2 = word align, 4 = dword align }
-          fillsize  : byte;   { real size to fill }
-          fillop    : byte;   { value to fill with - optional }
-          use_op    : boolean;
-          constructor Create(b:byte);virtual;
-          constructor Create_op(b: byte; _op: byte);virtual;
-          constructor Create_zeros(b:byte);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-          function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
-       end;
-       tai_align_class = class of tai_align_abstract;
-
-       taasmoutput = class(tlinkedlist)
-          constructor create;
-          function  empty : boolean;
-          function  getlasttaifilepos : pfileposinfo;
-          procedure InsertAfter(Item,Loc : TLinkedListItem);override;
-       end;
-
-       { Type of asmlists. The order is important for the layout of the
-         information in the .o file. The stabs for the types must be defined
-         before they can be referenced and therefor they need to be written
-         first (PFV) }
-       Tasmlist=(al_stabsstart,
-                 al_stabs,
-                 al_procedures,
-                 al_globals,
-                 al_const,
-                 al_typedconsts,
-                 al_rotypedconsts,
-                 al_threadvars,
-                 al_imports,
-                 al_exports,
-                 al_resources,
-                 al_rtti,
-                 al_dwarf,
-                 al_picdata,
-                 al_resourcestrings,
-                 al_stabsend);
-    const
-       TasmlistStr : array[tasmlist] of string[24] =(
-           'al_stabsstart',
-           'al_stabs',
-           'al_procedures',
-           'al_globals',
-           'al_const',
-           'al_typedconsts',
-           'al_rotypedconsts',
-           'al_threadvars',
-           'al_imports',
-           'al_exports',
-           'al_resources',
-           'al_rtti',
-           'al_dwarf',
-           'al_picdata',
-           'al_resourcestrings',
-           'al_stabsend');
-
-      regallocstr : array[tregalloctype] of string[10]=('allocated','released','sync','resized');
-      tempallocstr : array[boolean] of string[10]=('released','allocated');
-      stabtypestr : array[tstabtype] of string[5]=('stabs','stabn','stabd');
-      directivestr : array[tasmdirective] of string[24]=(
-        'non_lazy_symbol_pointer','indirect_symbol','lazy_symbol_pointer',
-        'extern','nasm_import'
-      );
-
-    var
-      { array with all class types for tais }
-      aiclass : taiclassarray;
-
-      { Current expression list }
-      exprasmlist : taasmoutput;
-
-      { labels for BREAK and CONTINUE }
-      aktbreaklabel,aktcontinuelabel : tasmlabel;
-
-      { label when the result is true or false }
-      truelabel,falselabel : tasmlabel;
-
-      { hook to notify uses of registers }
-      add_reg_instruction_hook : tadd_reg_instruction_proc;
-
-      asmlist:array[Tasmlist] of Taasmoutput;
-
-      cai_align : tai_align_class;
-      cai_cpu   : tai_cpu_class;
-
-    function  use_smartlink_section:boolean;
-    function  maybe_smartlink_symbol:boolean;
-
-    procedure maybe_new_object_file(list:taasmoutput);
-    procedure new_section(list:taasmoutput;Asectype:TAsmSectionType;Aname:string;Aalign:byte);
-    procedure section_symbol_start(list:taasmoutput;const Aname:string;Asymtyp:Tasmsymtype;
-                                   Aglobal:boolean;Asectype:TAsmSectionType;Aalign:byte);
-    procedure section_symbol_end(list:taasmoutput;const Aname:string);
-
-    function ppuloadai(ppufile:tcompilerppufile):tai;
-    procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
-
-
-implementation
-
-    uses
-      strings,
-      verbose;
-
-    const
-      pputaimarker = 254;
-
-
-{****************************************************************************
-                                 Helpers
- ****************************************************************************}
-
-    function ppuloadai(ppufile:tcompilerppufile):tai;
-      var
-        b : byte;
-        t : taitype;
-      begin
-        { marker }
-        b:=ppufile.getbyte;
-        if b<>pputaimarker then
-          internalerror(200208181);
-        { load nodetype }
-        t:=taitype(ppufile.getbyte);
-        if t<>ait_none then
-         begin
-           if t>high(taitype) then
-             internalerror(200208182);
-           if not assigned(aiclass[t]) then
-             internalerror(200208183);
-           {writeln('taiload: ',taitypestr[t]);}
-           { generate tai of the correct class }
-           ppuloadai:=aiclass[t].ppuload(t,ppufile);
-         end
-        else
-         ppuloadai:=nil;
-      end;
-
-
-    procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
-      begin
-        { marker, read by ppuloadnode }
-        ppufile.putbyte(pputaimarker);
-        if assigned(n) then
-         begin
-           { type, read by ppuloadnode }
-           ppufile.putbyte(byte(n.typ));
-           {writeln('taiwrite: ',taitypestr[n.typ]);}
-           n.ppuwrite(ppufile);
-         end
-        else
-         ppufile.putbyte(byte(ait_none));
-      end;
-
-
-    function use_smartlink_section:boolean;
-      begin
-        result:=(af_smartlink_sections in target_asm.flags) and
-                (tf_smartlink_sections in target_info.flags);
-      end;
-
-
-    function maybe_smartlink_symbol:boolean;
-      begin
-        result:=(cs_create_smart in aktmoduleswitches) or
-                use_smartlink_section;
-      end;
-
-
-    procedure maybe_new_object_file(list:taasmoutput);
-      begin
-        if (cs_create_smart in aktmoduleswitches) and
-           (not use_smartlink_section) then
-          list.concat(tai_cutobject.create);
-      end;
-
-
-    procedure new_section(list:taasmoutput;Asectype:TAsmSectionType;Aname:string;Aalign:byte);
-      begin
-        list.concat(tai_section.create(Asectype,Aname,Aalign));
-        list.concat(cai_align.create(Aalign));
-      end;
-
-
-    procedure section_symbol_start(list:taasmoutput;const Aname:string;Asymtyp:Tasmsymtype;
-                                   Aglobal:boolean;Asectype:TAsmSectionType;Aalign:byte);
-      begin
-        maybe_new_object_file(list);
-        list.concat(tai_section.create(Asectype,Aname,Aalign));
-        list.concat(cai_align.create(Aalign));
-        if Aglobal or
-           maybe_smartlink_symbol then
-          list.concat(tai_symbol.createname_global(Aname,Asymtyp,0))
-        else
-          list.concat(tai_symbol.createname(Aname,Asymtyp,0));
-      end;
-
-
-    procedure section_symbol_end(list:taasmoutput;const Aname:string);
-      begin
-        list.concat(tai_symbol_end.createname(Aname));
-      end;
-
-
-{****************************************************************************
-                             TAI
- ****************************************************************************}
-
-    constructor tai.Create;
-      begin
-{$ifndef NOOPT}
-        optinfo:=nil;
-{$endif NOOPT}
-      end;
-
-
-    constructor tai.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        typ:=t;
-{$ifndef NOOPT}
-        optinfo:=nil;
-{$endif}
-      end;
-
-
-    procedure tai.ppuwrite(ppufile:tcompilerppufile);
-      begin
-      end;
-
-
-    procedure tai.buildderefimpl;
-      begin
-      end;
-
-
-    procedure tai.derefimpl;
-      begin
-      end;
-
-
-{****************************************************************************
-                              TAILINEINFO
- ****************************************************************************}
-
-    constructor tailineinfo.create;
-     begin
-       inherited create;
-       if not(inlining_procedure and
-              (cs_gdb_valgrind in aktglobalswitches)) then
-         fileinfo:=aktfilepos;
-     end;
-
-
-    constructor tailineinfo.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        ppufile.getposinfo(fileinfo);
-      end;
-
-
-    procedure tailineinfo.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putposinfo(fileinfo);
-      end;
-
-
-{****************************************************************************
-                              TAI_SIMPLE
- ****************************************************************************}
-
-    constructor tai_simple.create(_typ : taitype);
-      begin
-        inherited create;
-        typ:=_typ;
-      end;
-
-
-{****************************************************************************
-                             TAI_SECTION
- ****************************************************************************}
-
-    constructor tai_section.Create(Asectype:TAsmSectionType;Aname:string;Aalign:byte);
-      begin
-        inherited Create;
-        typ:=ait_section;
-        sectype:=asectype;
-        secalign:=Aalign;
-        name:=stringdup(Aname);
-        sec:=nil;
-      end;
-
-
-    constructor tai_section.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        sectype:=tasmsectiontype(ppufile.getbyte);
-        secalign:=ppufile.getbyte;
-        name:=stringdup(ppufile.getstring);
-        sec:=nil;
-      end;
-
-
-    destructor tai_section.Destroy;
-      begin
-        stringdispose(name);
-      end;
-
-
-    procedure tai_section.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putbyte(byte(sectype));
-        ppufile.putbyte(secalign);
-        ppufile.putstring(name^);
-      end;
-
-
-{****************************************************************************
-                             TAI_DATABLOCK
- ****************************************************************************}
-
-    constructor tai_datablock.Create(const _name : string;_size : longint);
-
-      begin
-         inherited Create;
-         typ:=ait_datablock;
-         sym:=objectlibrary.newasmsymbol(_name,AB_LOCAL,AT_DATA);
-         { keep things aligned }
-         if _size<=0 then
-           _size:=4;
-         size:=_size;
-         is_global:=false;
-      end;
-
-
-    constructor tai_datablock.Create_global(const _name : string;_size : longint);
-      begin
-         inherited Create;
-         typ:=ait_datablock;
-         sym:=objectlibrary.newasmsymbol(_name,AB_GLOBAL,AT_DATA);
-         { keep things aligned }
-         if _size<=0 then
-           _size:=4;
-         size:=_size;
-         is_global:=true;
-      end;
-
-
-    constructor tai_datablock.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited Create;
-        sym:=ppufile.getasmsymbol;
-        size:=ppufile.getlongint;
-        is_global:=boolean(ppufile.getbyte);
-      end;
-
-
-    procedure tai_datablock.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putasmsymbol(sym);
-        ppufile.putlongint(size);
-        ppufile.putbyte(byte(is_global));
-      end;
-
-
-    procedure tai_datablock.derefimpl;
-      begin
-        objectlibrary.DerefAsmsymbol(sym);
-      end;
-
-
-{****************************************************************************
-                               TAI_SYMBOL
- ****************************************************************************}
-
-    constructor tai_symbol.Create(_sym:tasmsymbol;siz:longint);
-      begin
-         inherited Create;
-         typ:=ait_symbol;
-         sym:=_sym;
-         size:=siz;
-         sym.defbind:=AB_LOCAL;
-         is_global:=false;
-      end;
-
-    constructor tai_symbol.Create_global(_sym:tasmsymbol;siz:longint);
-      begin
-         inherited Create;
-         typ:=ait_symbol;
-         sym:=_sym;
-         size:=siz;
-         sym.defbind:=AB_GLOBAL;
-         is_global:=true;
-      end;
-
-    constructor tai_symbol.Createname(const _name : string;_symtyp:Tasmsymtype;siz:longint);
-      begin
-         inherited Create;
-         typ:=ait_symbol;
-         sym:=objectlibrary.newasmsymbol(_name,AB_LOCAL,_symtyp);
-         size:=siz;
-         is_global:=false;
-      end;
-
-    constructor tai_symbol.Createname_global(const _name : string;_symtyp:Tasmsymtype;siz:longint);
-      begin
-         inherited Create;
-         typ:=ait_symbol;
-         sym:=objectlibrary.newasmsymbol(_name,AB_GLOBAL,_symtyp);
-         size:=siz;
-         is_global:=true;
-      end;
-
-    constructor tai_symbol.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        sym:=ppufile.getasmsymbol;
-        size:=ppufile.getlongint;
-        is_global:=boolean(ppufile.getbyte);
-      end;
-
-
-    procedure tai_symbol.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putasmsymbol(sym);
-        ppufile.putlongint(size);
-        ppufile.putbyte(byte(is_global));
-      end;
-
-
-    procedure tai_symbol.derefimpl;
-      begin
-        objectlibrary.DerefAsmsymbol(sym);
-      end;
-
-
-{****************************************************************************
-                               TAI_SYMBOL_END
- ****************************************************************************}
-
-    constructor tai_symbol_end.Create(_sym:tasmsymbol);
-      begin
-         inherited Create;
-         typ:=ait_symbol_end;
-         sym:=_sym;
-      end;
-
-    constructor tai_symbol_end.Createname(const _name : string);
-      begin
-         inherited Create;
-         typ:=ait_symbol_end;
-         sym:=objectlibrary.newasmsymbol(_name,AB_GLOBAL,AT_NONE);
-      end;
-
-    constructor tai_symbol_end.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        sym:=ppufile.getasmsymbol;
-      end;
-
-
-    procedure tai_symbol_end.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putasmsymbol(sym);
-      end;
-
-
-    procedure tai_symbol_end.derefimpl;
-      begin
-        objectlibrary.DerefAsmsymbol(sym);
-      end;
-
-
-{****************************************************************************
-                               TAI_SYMBOL_END
- ****************************************************************************}
-
-    constructor tai_directive.Create(_directive:tasmdirective;const _name:string);
-      begin
-         inherited Create;
-         typ:=ait_directive;
-         name:=stringdup(_name);
-         directive:=_directive;
-      end;
-
-
-    destructor tai_directive.Destroy;
-      begin
-        stringdispose(name);
-      end;
-
-
-    constructor tai_directive.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        name:=stringdup(ppufile.getstring);
-        directive:=tasmdirective(ppufile.getbyte);
-      end;
-
-
-    procedure tai_directive.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putstring(name^);
-        ppufile.putbyte(byte(directive));
-      end;
-
-
-{****************************************************************************
-                               TAI_CONST
- ****************************************************************************}
-
-    constructor tai_const.Create(_typ:taitype;_value : int64);
-      begin
-         inherited Create;
-         typ:=_typ;
-         value:=_value;
-         sym:=nil;
-         endsym:=nil;
-      end;
-
-
-    constructor tai_const.Create_128bit(_value : int64);
-      begin
-         inherited Create;
-         typ:=ait_const_128bit;
-         value:=_value;
-         sym:=nil;
-         endsym:=nil;
-      end;
-
-
-    constructor tai_const.Create_64bit(_value : int64);
-      begin
-         inherited Create;
-         typ:=ait_const_64bit;
-         value:=_value;
-         sym:=nil;
-         endsym:=nil;
-      end;
-
-
-    constructor tai_const.Create_32bit(_value : longint);
-      begin
-         inherited Create;
-         typ:=ait_const_32bit;
-         value:=_value;
-         sym:=nil;
-         endsym:=nil;
-      end;
-
-
-    constructor tai_const.Create_16bit(_value : word);
-      begin
-         inherited Create;
-         typ:=ait_const_16bit;
-         value:=_value;
-         sym:=nil;
-         endsym:=nil;
-      end;
-
-
-    constructor tai_const.Create_8bit(_value : byte);
-      begin
-         inherited Create;
-         typ:=ait_const_8bit;
-         value:=_value;
-         sym:=nil;
-         endsym:=nil;
-      end;
-
-
-    constructor tai_const.Create_sleb128bit(_value : int64);
-      begin
-         inherited Create;
-         typ:=ait_const_sleb128bit;
-         value:=_value;
-         sym:=nil;
-         endsym:=nil;
-      end;
-
-
-    constructor tai_const.Create_uleb128bit(_value : qword);
-      begin
-         inherited Create;
-         typ:=ait_const_uleb128bit;
-         value:=int64(_value);
-         sym:=nil;
-         endsym:=nil;
-      end;
-
-
-    constructor tai_const.Create_aint(_value : aint);
-      begin
-         inherited Create;
-         typ:=ait_const_aint;
-         value:=_value;
-         sym:=nil;
-         endsym:=nil;
-      end;
-
-
-    constructor tai_const.Create_sym(_sym:tasmsymbol);
-      begin
-         inherited Create;
-         typ:=ait_const_ptr;
-         { sym is allowed to be nil, this is used to write nil pointers }
-         sym:=_sym;
-         endsym:=nil;
-         value:=0;
-         { update sym info }
-         if assigned(sym) then
-           sym.increfs;
-      end;
-
-
-    constructor tai_const.Create_sym_offset(_sym:tasmsymbol;ofs:aint);
-      begin
-         inherited Create;
-         typ:=ait_const_ptr;
-         if not assigned(_sym) then
-           internalerror(200404121);
-         sym:=_sym;
-         endsym:=nil;
-         value:=ofs;
-         { update sym info }
-         sym.increfs;
-      end;
-
-
-    constructor tai_const.Create_rel_sym(_typ:taitype;_sym,_endsym:tasmsymbol);
-      begin
-         inherited Create;
-         typ:=_typ;
-         sym:=_sym;
-         endsym:=_endsym;
-         value:=0;
-         { update sym info }
-         sym.increfs;
-         endsym.increfs;
-      end;
-
-
-    constructor tai_const.Create_rva_sym(_sym:tasmsymbol);
-      begin
-         inherited Create;
-         typ:=ait_const_rva_symbol;
-         sym:=_sym;
-         endsym:=nil;
-         value:=0;
-         { update sym info }
-         sym.increfs;
-      end;
-
-
-    constructor tai_const.Create_indirect_sym(_sym:tasmsymbol);
-      begin
-         inherited Create;
-         typ:=ait_const_indirect_symbol;
-         sym:=_sym;
-         endsym:=nil;
-         value:=0;
-         { update sym info }
-         sym.increfs;
-      end;
-
-
-    constructor tai_const.Createname(const name:string;_symtyp:Tasmsymtype;ofs:aint);
-      begin
-         inherited Create;
-         typ:=ait_const_ptr;
-         sym:=objectlibrary.newasmsymbol(name,AB_EXTERNAL,_symtyp);
-         endsym:=nil;
-         value:=ofs;
-         { update sym info }
-         sym.increfs;
-      end;
-
-
-    constructor tai_const.Createname_rva(const name:string);
-      begin
-         inherited Create;
-         typ:=ait_const_rva_symbol;
-         sym:=objectlibrary.newasmsymbol(name,AB_EXTERNAL,AT_FUNCTION);
-         endsym:=nil;
-         value:=0;
-         { update sym info }
-         sym.increfs;
-      end;
-
-
-    constructor tai_const.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        sym:=ppufile.getasmsymbol;
-        endsym:=ppufile.getasmsymbol;
-        value:=ppufile.getint64;
-      end;
-
-
-    procedure tai_const.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putasmsymbol(sym);
-        ppufile.putasmsymbol(endsym);
-        ppufile.putint64(value);
-      end;
-
-
-    procedure tai_const.derefimpl;
-      begin
-        objectlibrary.DerefAsmsymbol(sym);
-        objectlibrary.DerefAsmsymbol(endsym);
-      end;
-
-
-    function tai_const.getcopy:tlinkedlistitem;
-      begin
-        getcopy:=inherited getcopy;
-        { we need to increase the reference number }
-        sym.increfs;
-        if assigned(endsym) then
-          endsym.increfs;
-      end;
-
-
-    function tai_const.size:longint;
-      begin
-        case typ of
-          ait_const_8bit :
-            result:=1;
-          ait_const_16bit :
-            result:=2;
-          ait_const_32bit :
-            result:=4;
-          ait_const_64bit :
-            result:=8;
-          ait_const_indirect_symbol,
-          ait_const_rva_symbol :
-            result:=sizeof(aint);
-        end;
-      end;
-
-
-{****************************************************************************
-                               TAI_real_32bit
- ****************************************************************************}
-
-    constructor tai_real_32bit.Create(_value : ts32real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_32bit;
-         value:=_value;
-      end;
-
-    constructor tai_real_32bit.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        value:=ppufile.getreal;
-      end;
-
-
-    procedure tai_real_32bit.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putreal(value);
-      end;
-
-
-{****************************************************************************
-                               TAI_real_64bit
- ****************************************************************************}
-
-    constructor tai_real_64bit.Create(_value : ts64real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_64bit;
-         value:=_value;
-      end;
-
-
-{$ifdef ARM}
-    constructor tai_real_64bit.Create_hiloswapped(_value : ts64real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_64bit;
-         value:=_value;
-         formatoptions:=fo_hiloswapped;
-      end;
-{$endif ARM}
-
-    constructor tai_real_64bit.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        value:=ppufile.getreal;
-{$ifdef ARM}
-        formatoptions:=tformatoptions(ppufile.getbyte);
-{$endif ARM}
-      end;
-
-
-    procedure tai_real_64bit.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putreal(value);
-{$ifdef ARM}
-        ppufile.putbyte(byte(formatoptions));
-{$endif ARM}
-      end;
-
-
-{****************************************************************************
-                               TAI_real_80bit
- ****************************************************************************}
-
-    constructor tai_real_80bit.Create(_value : ts80real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_80bit;
-         value:=_value;
-      end;
-
-
-    constructor tai_real_80bit.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        value:=ppufile.getreal;
-      end;
-
-
-    procedure tai_real_80bit.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putreal(value);
-      end;
-
-
-{****************************************************************************
-                               TAI_real_80bit
- ****************************************************************************}
-
-    constructor tai_real_128bit.Create(_value : ts128real);
-
-      begin
-         inherited Create;
-         typ:=ait_real_128bit;
-         value:=_value;
-      end;
-
-
-    constructor tai_real_128bit.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        value:=ppufile.getreal;
-      end;
-
-
-    procedure tai_real_128bit.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putreal(value);
-      end;
-
-
-{****************************************************************************
-                               Tai_comp_64bit
- ****************************************************************************}
-
-    constructor tai_comp_64bit.Create(_value : ts64comp);
-
-      begin
-         inherited Create;
-         typ:=ait_comp_64bit;
-         value:=_value;
-      end;
-
-
-    constructor tai_comp_64bit.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        ppufile.putdata(value,sizeof(value));
-      end;
-
-
-    procedure tai_comp_64bit.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.getdata(value,sizeof(value));
-      end;
-
-
-{****************************************************************************
-                               TAI_STRING
- ****************************************************************************}
-
-     constructor tai_string.Create(const _str : string);
-       begin
-          inherited Create;
-          typ:=ait_string;
-          len:=length(_str);
-          getmem(str,len+1);
-          strpcopy(str,_str);
-       end;
-
-
-    constructor tai_string.Create_pchar(_str : pchar;length : longint);
-       begin
-          inherited Create;
-          typ:=ait_string;
-          str:=_str;
-          len:=length;
-       end;
-
-
-    destructor tai_string.destroy;
-      begin
-         if str<>nil then
-           freemem(str);
-         inherited Destroy;
-      end;
-
-
-    constructor tai_string.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        len:=ppufile.getlongint;
-        getmem(str,len);
-        ppufile.getdata(str^,len);
-      end;
-
-
-    procedure tai_string.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putlongint(len);
-        ppufile.putdata(str^,len);
-      end;
-
-
-    function tai_string.getcopy : tlinkedlistitem;
-      var
-        p : tlinkedlistitem;
-      begin
-        p:=inherited getcopy;
-        getmem(tai_string(p).str,len);
-        move(str^,tai_string(p).str^,len);
-        getcopy:=p;
-      end;
-
-
-{****************************************************************************
-                               TAI_LABEL
- ****************************************************************************}
-
-    constructor tai_label.create(_l : tasmlabel);
-      begin
-        inherited Create;
-        typ:=ait_label;
-        l:=_l;
-        l.is_set:=true;
-        is_global:=(l.defbind=AB_GLOBAL);
-      end;
-
-
-    constructor tai_label.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        l:=tasmlabel(ppufile.getasmsymbol);
-        is_global:=boolean(ppufile.getbyte);
-      end;
-
-
-    procedure tai_label.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putasmsymbol(l);
-        ppufile.putbyte(byte(is_global));
-      end;
-
-
-    procedure tai_label.derefimpl;
-      begin
-        objectlibrary.DerefAsmsymbol(tasmsymbol(l));
-        l.is_set:=true;
-      end;
-
-
-{****************************************************************************
-          tai_comment  comment to be inserted in the assembler file
- ****************************************************************************}
-
-     constructor tai_comment.Create(_str : pchar);
-
-       begin
-          inherited Create;
-          typ:=ait_comment;
-          str:=_str;
-       end;
-
-    destructor tai_comment.destroy;
-
-      begin
-         strdispose(str);
-         inherited Destroy;
-      end;
-
-    constructor tai_comment.ppuload(t:taitype;ppufile:tcompilerppufile);
-      var
-        len : longint;
-      begin
-        inherited ppuload(t,ppufile);
-        len:=ppufile.getlongint;
-        getmem(str,len+1);
-        ppufile.getdata(str^,len);
-        str[len]:=#0;
-      end;
-
-
-    procedure tai_comment.ppuwrite(ppufile:tcompilerppufile);
-      var
-        len : longint;
-      begin
-        inherited ppuwrite(ppufile);
-        len:=strlen(str);
-        ppufile.putlongint(len);
-        ppufile.putdata(str^,len);
-      end;
-
-
-    function tai_comment.getcopy : tlinkedlistitem;
-      var
-        p : tlinkedlistitem;
-      begin
-        p:=inherited getcopy;
-        getmem(tai_comment(p).str,strlen(str)+1);
-        move(str^,tai_comment(p).str^,strlen(str)+1);
-        getcopy:=p;
-      end;
-
-
-{****************************************************************************
-                              TAI_STABS
- ****************************************************************************}
-
-    constructor tai_stab.create(_stabtype:tstabtype;_str : pchar);
-      begin
-         inherited create;
-         typ:=ait_stab;
-         str:=_str;
-         stabtype:=_stabtype;
-      end;
-
-    constructor tai_stab.create_str(_stabtype:tstabtype;const s:string);
-      begin
-         self.create(_stabtype,strpnew(s));
-      end;
-
-    destructor tai_stab.destroy;
-      begin
-         strdispose(str);
-         inherited destroy;
-      end;
-
-
-{****************************************************************************
-                            TAI_FORCE_LINE
- ****************************************************************************}
-
-    constructor tai_force_line.create;
-      begin
-         inherited create;
-         typ:=ait_force_line;
-      end;
-
-
-{****************************************************************************
-                              TAI_FUNCTION_NAME
- ****************************************************************************}
-
-    constructor tai_function_name.create(const s:string);
-      begin
-         inherited create;
-         typ:=ait_function_name;
-         funcname:=stringdup(s);
-      end;
-
-    destructor tai_function_name.destroy;
-      begin
-         stringdispose(funcname);
-         inherited destroy;
-      end;
-
-
-{****************************************************************************
-                              TAI_CUTOBJECT
- ****************************************************************************}
-
-     constructor tai_cutobject.Create;
-       begin
-          inherited Create;
-          typ:=ait_cutobject;
-          place:=cut_normal;
-       end;
-
-
-     constructor tai_cutobject.Create_begin;
-       begin
-          inherited Create;
-          typ:=ait_cutobject;
-          place:=cut_begin;
-       end;
-
-
-     constructor tai_cutobject.Create_end;
-       begin
-          inherited Create;
-          typ:=ait_cutobject;
-          place:=cut_end;
-       end;
-
-
-    constructor tai_cutobject.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        place:=TCutPlace(ppufile.getbyte);
-      end;
-
-
-    procedure tai_cutobject.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putbyte(byte(place));
-      end;
-
-
-{****************************************************************************
-                             Tai_Marker
- ****************************************************************************}
-
-    constructor Tai_Marker.Create(_Kind: TMarker);
-      begin
-        Inherited Create;
-        typ := ait_marker;
-        Kind := _Kind;
-      end;
-
-
-    constructor Tai_Marker.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        kind:=TMarker(ppufile.getbyte);
-      end;
-
-
-    procedure Tai_Marker.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putbyte(byte(kind));
-      end;
-
-
-{*****************************************************************************
-                                tai_tempalloc
-*****************************************************************************}
-
-    constructor tai_tempalloc.alloc(pos,size:longint);
-      begin
-        inherited Create;
-        typ:=ait_tempalloc;
-        allocation:=true;
-        temppos:=pos;
-        tempsize:=size;
-{$ifdef EXTDEBUG}
-        problem:=nil;
-{$endif EXTDEBUG}
-      end;
-
-
-    destructor tai_tempalloc.destroy;
-      begin
-{$ifdef EXTDEBUG}
-        stringdispose(problem);
-{$endif EXTDEBUG}
-        inherited destroy;
-      end;
-
-
-    constructor tai_tempalloc.dealloc(pos,size:longint);
-      begin
-        inherited Create;
-        typ:=ait_tempalloc;
-        allocation:=false;
-        temppos:=pos;
-        tempsize:=size;
-{$ifdef EXTDEBUG}
-        problem:=nil;
-{$endif EXTDEBUG}
-      end;
-
-
-{$ifdef EXTDEBUG}
-    constructor tai_tempalloc.allocinfo(pos,size:longint;const st:string);
-      begin
-        inherited Create;
-        typ:=ait_tempalloc;
-        allocation:=false;
-        temppos:=pos;
-        tempsize:=size;
-        problem:=stringdup(st);
-      end;
-{$endif EXTDEBUG}
-
-
-    constructor tai_tempalloc.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        temppos:=ppufile.getlongint;
-        tempsize:=ppufile.getlongint;
-        allocation:=boolean(ppufile.getbyte);
-{$ifdef EXTDEBUG}
-        problem:=nil;
-{$endif EXTDEBUG}
-      end;
-
-
-    procedure tai_tempalloc.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putlongint(temppos);
-        ppufile.putlongint(tempsize);
-        ppufile.putbyte(byte(allocation));
-      end;
-
-
-{*****************************************************************************
-                                 tai_regalloc
-*****************************************************************************}
-
-    constructor tai_regalloc.alloc(r : tregister;ainstr:tai);
-      begin
-        inherited create;
-        typ:=ait_regalloc;
-        ratype:=ra_alloc;
-        reg:=r;
-        { ainstr must be an instruction }
-        if assigned(ainstr) and
-           (ainstr.typ<>ait_instruction) then
-          internalerror(200411011);
-        instr:=ainstr;
-      end;
-
-
-    constructor tai_regalloc.dealloc(r : tregister;ainstr:tai);
-      begin
-        inherited create;
-        typ:=ait_regalloc;
-        ratype:=ra_dealloc;
-        reg:=r;
-        { ainstr must be an instruction }
-        if assigned(ainstr) and
-           (ainstr.typ<>ait_instruction) then
-          internalerror(200411012);
-        instr:=ainstr;
-      end;
-
-
-    constructor tai_regalloc.sync(r : tregister);
-      begin
-        inherited create;
-        typ:=ait_regalloc;
-        ratype:=ra_sync;
-        reg:=r;
-      end;
-
-
-    constructor tai_regalloc.resize(r : tregister);
-      begin
-        inherited create;
-        typ:=ait_regalloc;
-        ratype:=ra_resize;
-        reg:=r;
-      end;
-
-
-    constructor tai_regalloc.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        ppufile.getdata(reg,sizeof(Tregister));
-        ratype:=tregalloctype(ppufile.getbyte);
-      end;
-
-
-    procedure tai_regalloc.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putdata(reg,sizeof(Tregister));
-        ppufile.putbyte(byte(ratype));
-      end;
-
-
-{*****************************************************************************
-                               TaiInstruction
-*****************************************************************************}
-
-    constructor tai_cpu_abstract.Create(op : tasmop);
-
-      begin
-         inherited create;
-         typ:=ait_instruction;
-         is_jmp:=false;
-         opcode:=op;
-         ops:=0;
-         fillchar(condition,sizeof(condition),0);
-         fillchar(oper,sizeof(oper),0);
-      end;
-
-
-    destructor tai_cpu_abstract.Destroy;
-      var
-        i : integer;
-      begin
-        for i:=0 to opercnt-1 do
-          begin
-            clearop(i);
-            dispose(oper[i]);
-          end;
-        inherited destroy;
-      end;
-
-
-{ ---------------------------------------------------------------------
-    Loading of operands.
-  ---------------------------------------------------------------------}
-
-    procedure tai_cpu_abstract.allocate_oper(opers:longint);
-      begin
-        while (opers>opercnt) do
-          begin
-            new(oper[opercnt]);
-            fillchar(oper[opercnt]^,sizeof(toper),0);
-            inc(opercnt);
-          end;
-      end;
-
-
-    procedure tai_cpu_abstract.loadconst(opidx:longint;l:aint);
-      begin
-        allocate_oper(opidx+1);
-        with oper[opidx]^ do
-         begin
-           if typ<>top_const then
-             clearop(opidx);
-           val:=l;
-           typ:=top_const;
-         end;
-      end;
-
-
-    procedure tai_cpu_abstract.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
-      var
-        r : treference;
-      begin
-        reference_reset_symbol(r,s,sofs);
-        r.refaddr:=addr_full;
-        loadref(opidx,r);
-      end;
-
-
-    procedure tai_cpu_abstract.loadlocal(opidx:longint;s:pointer;sofs:longint;indexreg:tregister;scale:byte;getoffset,forceref:boolean);
-      begin
-        if not assigned(s) then
-         internalerror(200204251);
-        allocate_oper(opidx+1);
-        with oper[opidx]^ do
-         begin
-           if typ<>top_local then
-             begin
-               clearop(opidx);
-               new(localoper);
-             end;
-           with oper[opidx]^.localoper^ do
-             begin
-               localsym:=s;
-               localsymofs:=sofs;
-               localindexreg:=indexreg;
-               localscale:=scale;
-               localgetoffset:=getoffset;
-               localforceref:=forceref;
-             end;
-           typ:=top_local;
-         end;
-      end;
-
-
-
-    procedure tai_cpu_abstract.loadref(opidx:longint;const r:treference);
-      begin
-        allocate_oper(opidx+1);
-        with oper[opidx]^ do
-          begin
-            if typ<>top_ref then
-              begin
-                clearop(opidx);
-                new(ref);
-              end;
-
-            ref^:=r;
-{$ifdef x86}
-            { We allow this exception for x86, since overloading this would be
-              too much of a a speed penalty}
-            if (ref^.segment<>NR_NO) and (ref^.segment<>NR_DS) then
-              segprefix:=ref^.segment;
-{$endif}
-{$ifdef extdebug}
-            if (cs_create_pic in aktmoduleswitches) and
-              assigned(r.symbol) and
-              (r.refaddr=addr_no) then
-              internalerror(200502052);
-{$endif}
-            typ:=top_ref;
-            if assigned(add_reg_instruction_hook) then
-              begin
-                add_reg_instruction_hook(self,ref^.base);
-                add_reg_instruction_hook(self,ref^.index);
-              end;
-            { mark symbol as used }
-            if assigned(ref^.symbol) then
-              ref^.symbol.increfs;
-          end;
-      end;
-
-
-    procedure tai_cpu_abstract.loadreg(opidx:longint;r:tregister);
-      begin
-        allocate_oper(opidx+1);
-        with oper[opidx]^ do
-         begin
-           if typ<>top_reg then
-             clearop(opidx);
-           reg:=r;
-           typ:=top_reg;
-         end;
-        if assigned(add_reg_instruction_hook) then
-          add_reg_instruction_hook(self,r);
-{$ifdef ARM}
-        { R15 is the PC on the ARM thus moves to R15 are jumps.
-          Due to speed considerations we don't use a virtual overridden method here.
-          Because the pc/r15 isn't handled by the reg. allocator this should never cause
-          problems with iregs getting r15.
-        }
-        is_jmp:=(opcode=A_MOV) and (opidx=0) and (r=NR_R15);
-{$endif ARM}
-      end;
-
-
-    procedure tai_cpu_abstract.loadoper(opidx:longint;o:toper);
-      begin
-        allocate_oper(opidx+1);
-        clearop(opidx);
-        oper[opidx]^:=o;
-        { copy also the reference }
-        with oper[opidx]^ do
-          begin
-            case typ of
-              top_reg:
-                begin
-                  if assigned(add_reg_instruction_hook) then
-                    add_reg_instruction_hook(self,reg);
-                end;
-              top_ref:
-                begin
-                  new(ref);
-                  ref^:=o.ref^;
-                  if assigned(add_reg_instruction_hook) then
-                    begin
-                      add_reg_instruction_hook(self,ref^.base);
-                      add_reg_instruction_hook(self,ref^.index);
-                    end;
-                end;
-{$ifdef ARM}
-              top_shifterop:
-                begin
-                  new(shifterop);
-                  shifterop^:=o.shifterop^;
-                  if assigned(add_reg_instruction_hook) then
-                    add_reg_instruction_hook(self,shifterop^.rs);
-                end;
-{$endif ARM}
-             end;
-          end;
-      end;
-
-    procedure tai_cpu_abstract.clearop(opidx:longint);
-      begin
-        with oper[opidx]^ do
-          begin
-            case typ of
-              top_ref:
-                dispose(ref);
-              top_local:
-                dispose(localoper);
-{$ifdef ARM}
-              top_shifterop:
-                dispose(shifterop);
-              top_regset:
-                dispose(regset);
-{$endif ARM}
-            end;
-            typ:=top_none;
-          end;
-      end;
-
-
-{ ---------------------------------------------------------------------
-    Miscellaneous methods.
-  ---------------------------------------------------------------------}
-
-    procedure tai_cpu_abstract.SetCondition(const c:TAsmCond);
-      begin
-         condition:=c;
-      end;
-
-
-    Function tai_cpu_abstract.getcopy:TLinkedListItem;
-      var
-        i : longint;
-        p : tai_cpu_abstract;
-      begin
-        p:=tai_cpu_abstract(inherited getcopy);
-        { make a copy of the references }
-        p.opercnt:=0;
-        p.allocate_oper(ops);
-        for i:=0 to ops-1 do
-          begin
-            p.oper[i]^:=oper[i]^;
-            case oper[i]^.typ of
-              top_local :
-                begin
-                  new(p.oper[i]^.localoper);
-                  p.oper[i]^.localoper^:=oper[i]^.localoper^;
-                end;
-              top_ref :
-                begin
-                  new(p.oper[i]^.ref);
-                  p.oper[i]^.ref^:=oper[i]^.ref^;
-                end;
-{$ifdef ARM}
-              top_shifterop:
-                begin
-                  new(p.oper[i]^.shifterop);
-                  p.oper[i]^.shifterop^:=oper[i]^.shifterop^;
-                end;
-{$endif ARM}
-            end;
-          end;
-        getcopy:=p;
-      end;
-
-
-    function tai_cpu_abstract.is_same_reg_move(regtype: Tregistertype):boolean;
-      begin
-        { When the generic RA is used this needs to be overriden, we don't use
-          virtual;abstract; to prevent a lot of warnings of unimplemented abstract methods
-          when tai_cpu is created (PFV) }
-        internalerror(200404091);
-        result:=false;
-      end;
-
-
-    function tai_cpu_abstract.spilling_get_operation_type(opnr: longint): topertype;
-      begin
-        internalerror(200404091);
-        result:=operand_readwrite;
-      end;
-
-
-    function tai_cpu_abstract.spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;
-      begin
-        result := operand_read;
-      end;
-
-
-    constructor tai_cpu_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
-      var
-        i : integer;
-      begin
-        inherited ppuload(t,ppufile);
-        { hopefully, we don't get problems with big/litte endian here when cross compiling :/ }
-        ppufile.getdata(condition,sizeof(tasmcond));
-        allocate_oper(ppufile.getbyte);
-        for i:=0 to ops-1 do
-          ppuloadoper(ppufile,oper[i]^);
-        opcode:=tasmop(ppufile.getword);
-{$ifdef x86}
-        ppufile.getdata(segprefix,sizeof(Tregister));
-{$endif x86}
-        is_jmp:=boolean(ppufile.getbyte);
-      end;
-
-
-    procedure tai_cpu_abstract.ppuwrite(ppufile:tcompilerppufile);
-      var
-        i : integer;
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putdata(condition,sizeof(tasmcond));
-        ppufile.putbyte(ops);
-        for i:=0 to ops-1 do
-          ppuwriteoper(ppufile,oper[i]^);
-        ppufile.putword(word(opcode));
-{$ifdef x86}
-        ppufile.putdata(segprefix,sizeof(Tregister));
-{$endif x86}
-        ppufile.putbyte(byte(is_jmp));
-      end;
-
-
-    procedure tai_cpu_abstract.buildderefimpl;
-      var
-        i : integer;
-      begin
-        for i:=0 to ops-1 do
-          ppubuildderefimploper(oper[i]^);
-      end;
-
-
-    procedure tai_cpu_abstract.derefimpl;
-      var
-        i : integer;
-      begin
-        for i:=0 to ops-1 do
-          ppuderefoper(oper[i]^);
-      end;
-
-
-{****************************************************************************
-                              tai_align_abstract
- ****************************************************************************}
-
-     constructor tai_align_abstract.Create(b: byte);
-       begin
-          inherited Create;
-          typ:=ait_align;
-          if b in [1,2,4,8,16,32] then
-            aligntype := b
-          else
-            aligntype := 1;
-          fillsize:=0;
-          fillop:=0;
-          use_op:=false;
-       end;
-
-
-     constructor tai_align_abstract.Create_op(b: byte; _op: byte);
-       begin
-          inherited Create;
-          typ:=ait_align;
-          if b in [1,2,4,8,16,32] then
-            aligntype := b
-          else
-            aligntype := 1;
-          fillsize:=0;
-          fillop:=_op;
-          use_op:=true;
-       end;
-
-
-     constructor tai_align_abstract.Create_zeros(b: byte);
-       begin
-          inherited Create;
-          typ:=ait_align;
-          if b in [1,2,4,8,16,32] then
-            aligntype := b
-          else
-            aligntype := 1;
-         use_op:=true;
-         fillsize:=0;
-         fillop:=0;
-       end;
-
-
-     function tai_align_abstract.calculatefillbuf(var buf : tfillbuffer):pchar;
-       begin
-         if fillsize>sizeof(buf) then
-           internalerror(200404293);
-         fillchar(buf,high(buf),fillop);
-         calculatefillbuf:=pchar(@buf);
-       end;
-
-
-    constructor tai_align_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
-      begin
-        inherited ppuload(t,ppufile);
-        aligntype:=ppufile.getbyte;
-        fillsize:=0;
-        fillop:=ppufile.getbyte;
-        use_op:=boolean(ppufile.getbyte);
-      end;
-
-
-    procedure tai_align_abstract.ppuwrite(ppufile:tcompilerppufile);
-      begin
-        inherited ppuwrite(ppufile);
-        ppufile.putbyte(aligntype);
-        ppufile.putbyte(fillop);
-        ppufile.putbyte(byte(use_op));
-      end;
-
-
-{*****************************************************************************
-                                 TAAsmOutput
-*****************************************************************************}
-
-    constructor taasmoutput.create;
-      begin
-        inherited create;
-        { make sure the optimizer won't remove the first tai of this list}
-        insert(tai_marker.create(marker_blockstart));
-      end;
-
-
-    function taasmoutput.empty : boolean;
-      begin
-        { there is always a marker_blockstart available,
-          see taasmoutput.create }
-        result:=(count<=1);
-      end;
-
-
-    function taasmoutput.getlasttaifilepos : pfileposinfo;
-      var
-       hp : tlinkedlistitem;
-      begin
-         getlasttaifilepos := nil;
-         if assigned(last) then
-           begin
-              { find the last file information record }
-              if not (tai(last).typ in SkipLineInfo) then
-                getlasttaifilepos:=@tailineinfo(last).fileinfo
-              else
-               { go through list backwards to find the first entry
-                 with line information
-               }
-               begin
-                 hp:=tai(last);
-                 while assigned(hp) and (tai(hp).typ in SkipLineInfo) do
-                    hp:=hp.Previous;
-                 { found entry }
-                 if assigned(hp) then
-                   getlasttaifilepos:=@tailineinfo(hp).fileinfo
-               end;
-           end;
-      end;
-
-    procedure Taasmoutput.InsertAfter(Item,Loc : TLinkedListItem);
-
-      begin
-        { This is not possible because it is not sure that the
-          tai at Loc has taifileinfo as parent }
-        {if assigned(Loc) then
-          tailineinfo(Item).fileinfo:=tailineinfo(Loc).fileinfo;}
-        inherited InsertAfter(Item,Loc);
-      end;
-
-begin
-  cai_cpu:=tai_cpu_abstract;
-  cai_align:=tai_align_abstract;
-end.

compiler/compiler/aggas.pas

@@ -1,870 +0,0 @@
-{
-    Copyright (c) 1998-2004 by the Free Pascal team
-
-    This unit implements generic GNU assembler (v2.8 or later)
-
-    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.
-
- ****************************************************************************
-}
-{ Base unit for writing GNU assembler output.
-}
-unit aggas;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-{$IFDEF USE_SYSUTILS}
-      SysUtils,
-{$ELSE USE_SYSUTILS}
-      dos,
-{$ENDIF USE_SYSUTILS}
-      cclasses,
-      globals,
-      aasmbase,aasmtai,aasmcpu,
-      assemble;
-
-
-    type
-      {# This is a derived class which is used to write
-         GAS styled assembler.
-
-         The WriteInstruction() method must be overriden
-         to write a single instruction to the assembler
-         file.
-      }
-      TGNUAssembler=class(texternalassembler)
-      protected
-        function sectionname(atype:tasmsectiontype;const aname:string):string;virtual;
-        procedure WriteSection(atype:tasmsectiontype;const aname:string);
-        procedure WriteExtraHeader;virtual;
-        procedure WriteInstruction(hp: tai);  virtual; abstract;
-      public
-        procedure WriteTree(p:TAAsmoutput);override;
-        procedure WriteAsmList;override;
-      end;
-
-
-implementation
-
-    uses
-      cutils,globtype,systems,
-      fmodule,finput,verbose,
-      itcpugas
-      ;
-
-    const
-      line_length = 70;
-
-    var
-      CurrSecType  : TAsmSectionType; { last section type written }
-      lastfileinfo : tfileposinfo;
-      infile,
-      lastinfile   : tinputfile;
-      symendcount  : longint;
-
-    type
-{$ifdef cpuextended}
-      t80bitarray = array[0..9] of byte;
-{$endif cpuextended}
-      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 single2str(d : single) : string;
-      var
-         hs : string;
-      begin
-         str(d,hs);
-      { replace space with + }
-         if hs[1]=' ' then
-          hs[1]:='+';
-         single2str:='0d'+hs
-      end;
-
-    function double2str(d : double) : string;
-      var
-         hs : string;
-      begin
-         str(d,hs);
-      { replace space with + }
-         if hs[1]=' ' then
-          hs[1]:='+';
-         double2str:='0d'+hs
-      end;
-
-    function extended2str(e : extended) : string;
-      var
-         hs : string;
-      begin
-         str(e,hs);
-      { replace space with + }
-         if hs[1]=' ' then
-          hs[1]:='+';
-         extended2str:='0d'+hs
-      end;
-
-
-  { convert floating point values }
-  { to correct endian             }
-  procedure swap64bitarray(var t: t64bitarray);
-    var
-     b: byte;
-    begin
-      b:= t[7];
-      t[7] := t[0];
-      t[0] := b;
-
-      b := t[6];
-      t[6] := t[1];
-      t[1] := b;
-
-      b:= t[5];
-      t[5] := t[2];
-      t[2] := b;
-
-      b:= t[4];
-      t[4] := t[3];
-      t[3] := b;
-   end;
-
-
-   procedure swap32bitarray(var t: t32bitarray);
-    var
-     b: byte;
-    begin
-      b:= t[1];
-      t[1]:= t[2];
-      t[2]:= b;
-
-      b:= t[0];
-      t[0]:= t[3];
-      t[3]:= b;
-    end;
-
-
-    const
-      ait_const2str : array[ait_const_128bit..ait_const_indirect_symbol] of string[20]=(
-        #9'.fixme128'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9,
-        #9'.sleb128'#9,#9'.uleb128'#9,
-        #9'.rva'#9,#9'.indirect_symbol'#9
-      );
-
-{****************************************************************************}
-{                          GNU Assembler writer                              }
-{****************************************************************************}
-
-    function TGNUAssembler.sectionname(atype:tasmsectiontype;const aname:string):string;
-      const
-        secnames : array[tasmsectiontype] of string[12] = ('',
-{$warning TODO .rodata not yet working}
-          '.text','.data','.data','.bss','.threadvar',
-          'common',
-          '.note',
-          '__TEXT', { stubs }
-          '.stab','.stabstr',
-          '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-          '.eh_frame',
-          '.debug_frame',
-          'fpc.resptrs'
-        );
-      begin
-        if use_smartlink_section and
-           (aname<>'') then
-          result:=secnames[atype]+'.'+aname
-        else
-          result:=secnames[atype];
-      end;
-
-
-    procedure TGNUAssembler.WriteSection(atype:tasmsectiontype;const aname:string);
-      var
-        s : string;
-      begin
-        AsmLn;
-        case target_info.system of
-         system_i386_OS2,
-         system_i386_EMX : ;
-         system_powerpc_darwin :
-           begin
-             if atype=sec_stub then
-               AsmWrite('.section ');
-           end;
-         else
-          AsmWrite('.section ');
-        end;
-        s:=sectionname(atype,aname);
-        AsmWrite(s);
-        case atype of
-          sec_fpc :
-            AsmWrite(', "a", @progbits');
-          sec_stub :
-            begin
-              if target_info.system=system_powerpc_darwin then
-                AsmWrite(',__symbol_stub1,symbol_stubs,pure_instructions,16');
-            end;
-        end;
-        AsmLn;
-        CurrSecType:=atype;
-      end;
-
-
-    procedure TGNUAssembler.WriteTree(p:TAAsmoutput);
-
-    function needsObject(hp : tai_symbol) : boolean;
-    begin
-      needsObject :=
-          assigned(hp.next) and
-          (tai_symbol(hp.next).typ in [ait_const_rva_symbol,
-             ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock,
-             ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]);
-    end;
-
-    var
-      ch       : char;
-      hp       : tai;
-      hp1      : tailineinfo;
-      consttyp : taitype;
-      s        : string;
-      i,pos,l  : longint;
-      InlineLevel : longint;
-      last_align : longint;
-      co       : comp;
-      sin      : single;
-      d        : double;
-{$ifdef cpuextended}
-      e        : extended;
-{$endif cpuextended}
-      do_line  : boolean;
-
-      sepChar : char;
-    begin
-      if not assigned(p) then
-       exit;
-
-      last_align := 2;
-      InlineLevel:=0;
-      { lineinfo is only needed for al_procedures (PFV) }
-      do_line:=(cs_asm_source in aktglobalswitches) or
-               ((cs_lineinfo in aktmoduleswitches)
-                 and (p=asmlist[al_procedures]));
-      hp:=tai(p.first);
-      while assigned(hp) do
-       begin
-         if not(hp.typ in SkipLineInfo) then
-          begin
-            hp1 := hp as tailineinfo;
-            aktfilepos:=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 aktglobalswitches) 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 aktglobalswitches) 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 aktglobalswitches) then
-                 begin
-                   AsmWrite(#9+target_asm.comment+'Register ');
-                   repeat
-                     AsmWrite(gas_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 aktglobalswitches) 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
-               if tai_align(hp).aligntype>1 then
-                 begin
-                   if target_info.system <> system_powerpc_darwin then
-                     begin
-                       AsmWrite(#9'.balign '+tostr(tai_align(hp).aligntype));
-                       if tai_align(hp).use_op then
-                        AsmWrite(','+tostr(tai_align(hp).fillop))
-                     end
-                   else
-                     begin
-                       { darwin as only supports .align }
-                       if not ispowerof2(tai_align(hp).aligntype,i) then
-                         internalerror(2003010305);
-                       AsmWrite(#9'.align '+tostr(i));
-                       last_align := i;
-                     end;
-                   AsmLn;
-                 end;
-             end;
-
-           ait_section :
-             begin
-               if tai_section(hp).sectype<>sec_none then
-                 WriteSection(tai_section(hp).sectype,tai_section(hp).name^)
-               else
-                 begin
-{$ifdef EXTDEBUG}
-                   AsmWrite(target_asm.comment);
-                   AsmWriteln(' sec_none');
-{$endif EXTDEBUG}
-                end;
-             end;
-
-           ait_datablock :
-             begin
-               if target_info.system=system_powerpc_darwin then
-                 begin
-                   {On Mac OS X you can't have common symbols in a shared
-                    library, since those are in the TEXT section and the text section is
-                    read-only in shared libraries (so it can be shared among different
-                    processes). The alternate code creates some kind of common symbols in
-                    the data segment. The generic code no longer uses common symbols, but
-                    this doesn't work on Mac OS X as well.}
-                   if tai_datablock(hp).is_global then
-                     begin
-                       asmwrite('.globl ');
-                       asmwriteln(tai_datablock(hp).sym.name);
-                       asmwriteln('.data');
-                       asmwrite('.zerofill __DATA, __common, ');
-                       asmwrite(tai_datablock(hp).sym.name);
-                       asmwriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align));
-                       if not(CurrSecType in [sec_data,sec_none]) then
-                         writesection(CurrSecType,'');
-                     end
-                   else
-                     begin
-                       asmwrite(#9'.lcomm'#9);
-                       asmwrite(tai_datablock(hp).sym.name);
-                       asmwrite(','+tostr(tai_datablock(hp).size));
-                       asmwrite(','+tostr(last_align));
-                       asmwriteln('');
-                     end
-                 end
-               else
-                 begin
-                   if Tai_datablock(hp).is_global then
-                     begin
-                       asmwrite(#9'.globl ');
-                       asmwriteln(Tai_datablock(hp).sym.name);
-                     end;
-                   asmwrite(Tai_datablock(hp).sym.name);
-                   asmwriteln(':');
-                   asmwriteln(#9'.space '+tostr(Tai_datablock(hp).size));
-                 end;
-             end;
-
-{$ifndef cpu64bit}
-           ait_const_128bit :
-              begin
-                internalerror(200404291);
-              end;
-
-           ait_const_64bit :
-              begin
-                if assigned(tai_const(hp).sym) then
-                  internalerror(200404292);
-                AsmWrite(ait_const2str[ait_const_32bit]);
-                if target_info.endian = endian_little then
-                  begin
-                    AsmWrite(tostr(longint(lo(tai_const(hp).value))));
-                    AsmWrite(',');
-                    AsmWrite(tostr(longint(hi(tai_const(hp).value))));
-                  end
-                else
-                  begin
-                    AsmWrite(tostr(longint(hi(tai_const(hp).value))));
-                    AsmWrite(',');
-                    AsmWrite(tostr(longint(lo(tai_const(hp).value))));
-                  end;
-                AsmLn;
-              end;
-{$endif cpu64bit}
-
-           ait_const_uleb128bit,
-           ait_const_sleb128bit,
-{$ifdef cpu64bit}
-           ait_const_128bit,
-           ait_const_64bit,
-{$endif cpu64bit}
-           ait_const_32bit,
-           ait_const_16bit,
-           ait_const_8bit,
-           ait_const_rva_symbol,
-           ait_const_indirect_symbol :
-             begin
-               AsmWrite(ait_const2str[hp.typ]);
-               consttyp:=hp.typ;
-               l:=0;
-               repeat
-                 if assigned(tai_const(hp).sym) then
-                   begin
-                     if assigned(tai_const(hp).endsym) then
-                       s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
-                     else
-                       s:=tai_const(hp).sym.name;
-                     if tai_const(hp).value<>0 then
-                       s:=s+tostr_with_plus(tai_const(hp).value);
-                   end
-                 else
-                   s:=tostr(tai_const(hp).value);
-                 AsmWrite(s);
-                 inc(l,length(s));
-                 { Values with symbols are written on a single line to improve
-                   reading of the .s file (PFV) }
-                 if assigned(tai_const(hp).sym) or
-                    not(CurrSecType in [sec_data,sec_rodata]) or
-                    (l>line_length) or
-                    (hp.next=nil) or
-                    (tai(hp.next).typ<>consttyp) or
-                    assigned(tai_const(hp.next).sym) then
-                   break;
-                 hp:=tai(hp.next);
-                 AsmWrite(',');
-               until false;
-               AsmLn;
-             end;
-
-{$ifdef cpuextended}
-           ait_real_80bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value));
-             { Make sure e is a extended type, bestreal could be
-               a different type (bestreal) !! (PFV) }
-               e:=tai_real_80bit(hp).value;
-               AsmWrite(#9'.byte'#9);
-               for i:=0 to 9 do
-                begin
-                  if i<>0 then
-                   AsmWrite(',');
-                  AsmWrite(tostr(t80bitarray(e)[i]));
-                end;
-               AsmLn;
-             end;
-{$endif cpuextended}
-
-           ait_real_64bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
-               d:=tai_real_64bit(hp).value;
-               { swap the values to correct endian if required }
-               if source_info.endian <> target_info.endian then
-                 swap64bitarray(t64bitarray(d));
-               AsmWrite(#9'.byte'#9);
-{$ifdef arm}
-{ on a real arm cpu, it's already hi/lo swapped }
-{$ifndef cpuarm}
-               if tai_real_64bit(hp).formatoptions=fo_hiloswapped then
-                 begin
-                   for i:=4 to 7 do
-                     begin
-                       if i<>4 then
-                         AsmWrite(',');
-                       AsmWrite(tostr(t64bitarray(d)[i]));
-                     end;
-                   for i:=0 to 3 do
-                     begin
-                       AsmWrite(',');
-                       AsmWrite(tostr(t64bitarray(d)[i]));
-                     end;
-                 end
-               else
-{$endif cpuarm}
-{$endif arm}
-                 begin
-                   for i:=0 to 7 do
-                     begin
-                       if i<>0 then
-                         AsmWrite(',');
-                       AsmWrite(tostr(t64bitarray(d)[i]));
-                     end;
-                 end;
-               AsmLn;
-             end;
-
-           ait_real_32bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
-               sin:=tai_real_32bit(hp).value;
-               { swap the values to correct endian if required }
-               if source_info.endian <> target_info.endian then
-                 swap32bitarray(t32bitarray(sin));
-               AsmWrite(#9'.byte'#9);
-               for i:=0 to 3 do
-                begin
-                  if i<>0 then
-                   AsmWrite(',');
-                  AsmWrite(tostr(t32bitarray(sin)[i]));
-                end;
-               AsmLn;
-             end;
-
-           ait_comp_64bit :
-             begin
-               if do_line then
-                AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value));
-               AsmWrite(#9'.byte'#9);
-{$ifdef FPC}
-               co:=comp(tai_comp_64bit(hp).value);
-{$else}
-               co:=tai_comp_64bit(hp).value;
-{$endif}
-               { swap the values to correct endian if required }
-               if source_info.endian <> target_info.endian then
-                 swap64bitarray(t64bitarray(co));
-               for i:=0 to 7 do
-                begin
-                  if i<>0 then
-                   AsmWrite(',');
-                  AsmWrite(tostr(t64bitarray(co)[i]));
-                end;
-               AsmLn;
-             end;
-
-           ait_string :
-             begin
-               pos:=0;
-               for i:=1 to tai_string(hp).len do
-                begin
-                  if pos=0 then
-                   begin
-                     AsmWrite(#9'.ascii'#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).l.is_used) then
-                begin
-                  if tai_label(hp).l.defbind=AB_GLOBAL then
-                   begin
-                     AsmWrite('.globl'#9);
-                     AsmWriteLn(tai_label(hp).l.name);
-                   end;
-                  AsmWrite(tai_label(hp).l.name);
-                  AsmWriteLn(':');
-                end;
-             end;
-           ait_symbol :
-             begin
-               if tai_symbol(hp).is_global then
-                begin
-                  AsmWrite('.globl'#9);
-                  AsmWriteLn(tai_symbol(hp).sym.name);
-                end;
-               if (target_info.system = system_powerpc64_linux) and
-                 (tai_symbol(hp).sym.typ = AT_FUNCTION) then
-                 begin
-                   AsmWriteLn('.section "opd", "aw"');
-                   AsmWriteLn('.align 3');
-                   AsmWriteLn(tai_symbol(hp).sym.name + ':');
-                   AsmWriteLn('.quad .' + tai_symbol(hp).sym.name + ', .TOC.@tocbase, 0');
-                   AsmWriteLn('.previous');
-                   AsmWriteLn('.size ' + tai_symbol(hp).sym.name + ', 24');
-                   AsmWriteLn('.globl .' + tai_symbol(hp).sym.name);
-                   AsmWriteLn('.type .' + tai_symbol(hp).sym.name + ', @function');
-                   { the dotted name is the name of the actual function }
-                   AsmWrite('.');
-                 end
-               else
-                 begin
-                   if (target_info.system <> system_arm_linux) then
-                     begin
-                       sepChar := '@';
-                     end
-                   else
-                     begin
-                       sepChar := '#';
-                     end;
-
-                   if (tf_needs_symbol_type in target_info.flags) then
-                     begin
-                       AsmWrite(#9'.type'#9 + tai_symbol(hp).sym.name);
-                       if (needsObject(tai_symbol(hp))) then
-                         begin
-                           AsmWriteLn(',' + sepChar + 'object');
-                         end
-                       else
-                         begin
-                           AsmWriteLn(',' + sepChar + 'function');
-                         end;
-                     end;
-                   if (tf_needs_symbol_size in target_info.flags) and (tai_symbol(hp).sym.size > 0) then begin
-                     AsmWriteLn(#9'.size'#9 + tai_symbol(hp).sym.name + ', ' + tostr(tai_symbol(hp).sym.size));
-                   end;
-                 end;
-               AsmWriteLn(tai_symbol(hp).sym.name + ':');
-             end;
-
-           ait_symbol_end :
-             begin
-               if tf_needs_symbol_size in target_info.flags then
-                begin
-                  s:=target_asm.labelprefix+'e'+tostr(symendcount);
-                  inc(symendcount);
-                  AsmWriteLn(s+':');
-                  AsmWrite(#9'.size'#9);
-                  if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
-                    begin
-                      AsmWrite('.');
-                    end;
-                  AsmWrite(tai_symbol_end(hp).sym.name);
-                  AsmWrite(', '+s+' - ');
-                  if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then
-                    begin
-                      AsmWrite('.');
-                    end;
-                  AsmWriteLn(tai_symbol_end(hp).sym.name);
-                end;
-             end;
-
-           ait_instruction :
-             begin
-               WriteInstruction(hp);
-             end;
-
-           ait_stab :
-             begin
-               if assigned(tai_stab(hp).str) then
-                 begin
-                   AsmWrite(#9'.'+stabtypestr[tai_stab(hp).stabtype]+' ');
-                   AsmWritePChar(tai_stab(hp).str);
-                   AsmLn;
-                 end;
-             end;
-
-           ait_force_line,
-           ait_function_name : ;
-
-           ait_cutobject :
-             begin
-               if SmartAsm then
-                begin
-                { only reset buffer if nothing has changed }
-                  if AsmSize=AsmStartSize then
-                   AsmClear
-                  else
-                   begin
-                     AsmClose;
-                     DoAssemble;
-                     AsmCreate(tai_cutobject(hp).place);
-                   end;
-                { avoid empty files }
-                  while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
-                   begin
-                     if tai(hp.next).typ=ait_section then
-                       CurrSecType:=tai_section(hp.next).sectype;
-                     hp:=tai(hp.next);
-                   end;
-                  if CurrSecType<>sec_none then
-                    WriteSection(CurrSecType,'');
-                  AsmStartSize:=AsmSize;
-                end;
-             end;
-
-           ait_marker :
-             if tai_marker(hp).kind=InlineStart then
-               inc(InlineLevel)
-             else if tai_marker(hp).kind=InlineEnd then
-               dec(InlineLevel);
-
-           ait_directive :
-             begin
-               AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
-               if assigned(tai_directive(hp).name) then
-                 AsmWrite(tai_directive(hp).name^);
-               AsmLn;
-             end;
-
-           else
-             internalerror(10000);
-         end;
-         hp:=tai(hp.next);
-       end;
-    end;
-
-
-    procedure TGNUAssembler.WriteExtraHeader;
-
-      begin
-      end;
-
-    procedure TGNUAssembler.WriteAsmList;
-    var
-      p:dirstr;
-      n:namestr;
-      e:extstr;
-      hal : tasmlist;
-    begin
-{$ifdef EXTDEBUG}
-      if assigned(current_module.mainsource) then
-       Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^);
-{$endif}
-
-      CurrSecType:=sec_none;
-      FillChar(lastfileinfo,sizeof(lastfileinfo),0);
-      LastInfile:=nil;
-
-      if assigned(current_module.mainsource) then
-{$IFDEF USE_SYSUTILS}
-      begin
-       p := SplitPath(current_module.mainsource^);
-       n := SplitName(current_module.mainsource^);
-       e := SplitExtension(current_module.mainsource^);
-      end
-{$ELSE USE_SYSUTILS}
-       fsplit(current_module.mainsource^,p,n,e)
-{$ENDIF USE_SYSUTILS}
-      else
-       begin
-         p:=inputdir;
-         n:=inputfile;
-         e:=inputextension;
-       end;
-    { to get symify to work }
-      AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
-      WriteExtraHeader;
-      AsmStartSize:=AsmSize;
-      symendcount:=0;
-
-      for hal:=low(Tasmlist) to high(Tasmlist) do
-        begin
-          AsmWriteLn(target_asm.comment+'Begin asmlist '+TasmlistStr[hal]);
-          writetree(asmlist[hal]);
-          AsmWriteLn(target_asm.comment+'End asmlist '+TasmlistStr[hal]);
-        end;
-
-      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;
-
-end.

compiler/compiler/alpha/aasmcpu.pas

@@ -1,281 +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;
-
-    type
-      tai_frame = class(tai)
-         G,R : TRegister;
-         LS,LU : longint;
-        Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
-        end;
-
-      tai_ent = class(tai)
-        Name : string;
-        Constructor Create (const ProcName : String);
-        end;
-
-
-      taicpu = class(taicpu_abstract)
-         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;
-
-    Constructor tai_ent.Create (const ProcName : String);
-
-    begin
-      Inherited Create;
-      typ:=ait_ent;
-      Name:=ProcName;
-    end;
-
-    procedure InitAsm;
-      begin
-      end;
-
-
-    procedure DoneAsm;
-      begin
-      end;
-
-
-    end.

compiler/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,
-       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/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/compiler/alpha/aoptcpub.pas

@@ -1,115 +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                                               }
-
-{$define RefsHaveIndexReg}
-
-{ 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/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/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/compiler/alpha/cgcpu.pas

@@ -1,160 +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,aasmcpu,cginfo,cpubase,cpuinfo;
-
-type
-pcgalpha = ^tcgalpha;
-tcgalpha = class(tcg)
-  procedure a_call_name(list : taasmoutput;const s : string);override;
-  procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);override;
-  procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);override;
-  procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);override;
-  procedure a_load_reg_reg(list : taasmoutput;fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
-  procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
-    reg : tregister;  l : tasmlabel);override;
-  procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
-  procedure a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
-  procedure a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
-    reg : tregister; l : tasmlabel);
-  procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
-  procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
-  procedure g_maybe_loadself(list : taasmoutput);override;
-  procedure g_restore_frame_pointer(list : taasmoutput);override;
-end;
-
-implementation
-
-uses
-   globtype,globals;
-
-procedure tcgalpha.g_stackframe_entry(list : taasmoutput;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 : taasmoutput;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 : taasmoutput;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 : taasmoutput;size : tcgsize;a : aword;register : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);
-
-begin
-end;
-
-
-procedure tcgalpha.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.a_load_reg_reg(list : taasmoutput;fromsize, tosize : tcgsize;reg1,reg2 : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
-  l : tasmlabel);
-
-begin
-end;
-
-
-procedure tcgalpha.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
-
-begin
-end;
-
-
-procedure tcgalpha.a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
-
-begin
-end;
-
-
-procedure tcgalpha.a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
-  reg : tregister; l : tasmlabel);
-
-begin
-end;
-
-
-procedure tcgalpha.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
-
-begin
-end;
-
-
-procedure tcgalpha.g_maybe_loadself(list : taasmoutput);
-
-begin
-end;
-
-
-procedure tcgalpha.g_restore_frame_pointer(list : taasmoutput);
-
-begin
-end;
-
-
-end.

compiler/compiler/alpha/cpubase.pas

@@ -1,457 +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,             }
-       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;
-
-       { Constant defining possibly all registers which might require saving }
-       ALL_REGISTERS = [firstreg..lastreg];
-
-       general_registers = [R_0..R_31];
-
-       availabletempregsint = [R_0..R_14,R_16..R_25,R_28];
-       availabletempregsfpu = [R_F0..R_F30];
-       availabletempregsmm  = [];
-
-       intregs = [R_0..R_31];
-       usableregsint = [];
-       c_countusableregsint = 26;
-
-       maxfpuregs = 32;
-       fpuregs = [R_F0..R_F31];
-       usableregsfpu = [];
-       c_countusableregsfpu = 31;
-
-       mmregs = [];
-       usableregsmm = [];
-       c_countusableregsmm  = 0;
-
-       max_operands = 4;
-
-       registers_saved_on_cdecl = [R_9..R_14,R_F2..R_F9];
-
-       firstsaveintreg = R_NO;
-       lastsaveintreg  = R_NO;
-       firstsavefpureg = R_NO;
-       lastsavefpureg  = R_NO;
-       firstsavemmreg  = R_NO;
-       lastsavemmreg   = R_NO;
-       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/compiler/alpha/cpuinfo.pas

@@ -1,68 +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
-
-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;
-   ts32real = single;
-   ts64real = double;
-   ts80real = extended;
-   ts64comp = extended;
-
-   pbestreal=^bestreal;
-
-   { possible supported processors for this target }
-   tprocessors =
-      (no_processor,
-       ClassEV7,
-       ClassEV8
-      );
-
-Const
-   { Size of native extended type }
-   extended_size = 16;
-   {# Size of a pointer                           }
-   sizeof(aint)  = 8;
-   {# Size of a multimedia register               }
-   mmreg_size = 8;
-
-   { target cpu string (used by compiler options) }
-   target_cpu_string = 'alpha';
-
-Implementation
-
-end.

compiler/compiler/alpha/cpunode.pas

@@ -1,54 +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
-       ;
-
-end.

compiler/compiler/alpha/cpupara.pas

@@ -1,290 +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
-       talphaparamanager = class(tparamanager)
-          function getintparaloc(nr : longint) : tparalocation;override;
-          procedure create_param_loc_info(p : tabstractprocdef);override;
-          function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
-       end;
-
-  implementation
-
-    uses
-       verbose,
-       globtype,
-       cpuinfo,cginfo,cgbase,
-       defbase;
-
-    function talphaparamanager.getintparaloc(nr : longint) : tparalocation;
-
-      begin
-         fillchar(result,sizeof(tparalocation),0);
-         if nr<1 then
-           internalerror(2002070801)
-         else if nr<=8 then
-           begin
-              result.loc:=LOC_REGISTER;
-              result.register:=tregister(longint(R_2)+nr);
-           end
-         else
-           begin
-              result.loc:=LOC_REFERENCE;
-              result.reference.index:=stack_pointer_reg;
-              result.reference.offset:=(nr-8)*4;
-           end;
-      end;
-
-    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.deftype 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 talphaparamanager.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.rettype.def) then
-           begin
-              if not(ret_in_reg(p.rettype.def)) 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 talphaparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
-      begin
-         case p.rettype.def.deftype of
-            orddef,
-            enumdef:
-              begin
-                getfuncretparaloc.loc:=LOC_REGISTER;
-                getfuncretparaloc.register:=R_3;
-                getfuncretparaloc.size:=def_cgsize(p.rettype.def);
-                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.rettype.def);
-              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:=talphaparamanager.create;
-end.

compiler/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/compiler/alpha/cpuswtch.pas

@@ -1,121 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
-
-    This units interprets the commandline options which are Alpha specific.
-
-    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 units interprets the commandline options which are Alpha specific.
-}
-unit cpuswtch;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  options;
-
-type
-  toptionalpha = class(toption)
-    procedure interpret_proc_specific_options(const opt:string);override;
-  end;
-
-implementation
-
-uses
-  cutils,globtype,systems,globals;
-
-procedure toptionalpha.interpret_proc_specific_options(const opt:string);
-var
-  more: string;
-  j: longint;
-begin
-  More:=Upper(copy(opt,3,length(opt)-2));
-  case opt[2] of
-   'O' : Begin
-           j := 3;
-           While (j <= Length(Opt)) Do
-             Begin
-               case opt[j] of
-                 '-' :
-                   begin
-                     initglobalswitches:=initglobalswitches-[cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_littlesize,
-                       cs_regalloc,cs_uncertainopts];
-                     FillChar(ParaAlignment,sizeof(ParaAlignment),0);
-                   end;
-                 'a' :
-                   begin
-                     UpdateAlignmentStr(Copy(Opt,j+1,255),ParaAlignment);
-                     j:=length(Opt);
-                   end;
-                 'g' : initglobalswitches:=initglobalswitches+[cs_littlesize];
-                 'G' : initglobalswitches:=initglobalswitches-[cs_littlesize];
-                 'r' :
-                   begin
-                     initglobalswitches:=initglobalswitches+[cs_regalloc];
-                     Simplify_ppu:=false;
-                   end;
-                 'u' : initglobalswitches:=initglobalswitches+[cs_uncertainopts];
-                 '1' : initglobalswitches:=initglobalswitches-[cs_fastoptimize,cs_slowoptimize]+[cs_optimize];
-                 '2' : initglobalswitches:=initglobalswitches-[cs_slowoptimize]+[cs_optimize,cs_fastoptimize];
-                 '3' : initglobalswitches:=initglobalswitches+[cs_optimize,cs_fastoptimize,cs_slowoptimize];
-{$ifdef dummy}
-                 'p' :
-                   Begin
-                     If j < Length(Opt) Then
-                       Begin
-                         Case opt[j+1] Of
-                           '1': initoptprocessor := Class386;
-                           '2': initoptprocessor := ClassP5;
-                           '3': initoptprocessor := ClassP6
-                           Else IllegalPara(Opt)
-                         End;
-                         Inc(j);
-                       End
-                     Else IllegalPara(opt)
-                   End;
-{$endif dummy}
-                 else IllegalPara(opt);
-               End;
-               Inc(j)
-             end;
-         end;
-{$ifdef dummy}
-   'R' : begin
-           if More='GAS' then
-            initasmmode:=asmmode_ppc_gas
-           else
-            if More='MOTOROLA' then
-             initasmmode:=asmmode_ppc_motorola
-           else
-            if More='DIRECT' then
-             initasmmode:=asmmode_direct
-           else
-            IllegalPara(opt);
-         end;
-{$endif dummy}
-  else
-   IllegalPara(opt);
-  end;
-end;
-
-
-initialization
-  coption:=toptionalpha;
-end.

compiler/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/compiler/alpha/radirect.pas

@@ -1,313 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    Reads inline Alpha assembler and writes the lines direct to the output
-
-    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 reads Alpha inline assembler and writes the lines direct to the output file.
-}
-unit radirect;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      node;
-
-     function assemble : tnode;
-
-  implementation
-
-    uses
-       { common }
-       cutils,
-       { global }
-       globals,verbose,
-       systems,
-       { aasm }
-       aasmbase,aasmtai,aasmcpu,
-       { symtable }
-       symconst,symbase,symtype,symsym,symtable,defbase,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner,
-       { codegen }
-       cgbase,
-       { constants }
-       agaxpgas,
-       cpubase
-       ;
-
-    function assemble : tnode;
-
-      var
-         retstr,s,hs : string;
-         c : char;
-         ende : boolean;
-         srsym,sym : tsym;
-         srsymtable : tsymtable;
-         code : TAAsmoutput;
-         i,l : longint;
-
-       procedure writeasmline;
-         var
-           i : longint;
-         begin
-           i:=length(s);
-           while (i>0) and (s[i] in [' ',#9]) do
-            dec(i);
-           s[0]:=chr(i);
-           if s<>'' then
-            code.concat(Tai_direct.Create(strpnew(s)));
-            { consider it set function set if the offset was loaded }
-           if assigned(aktprocdef.funcretsym) and
-              (pos(retstr,upper(s))>0) then
-             tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-           s:='';
-         end;
-
-     begin
-       ende:=false;
-       s:='';
-       if assigned(aktprocdef.funcretsym) and
-          is_fpu(aktprocdef.rettype.def) then
-         tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-       { !!!!!
-       if (not is_void(aktprocdef.rettype.def)) then
-         retstr:=upper(tostr(procinfo^.return_offset)+'('+gas_reg2str[procinfo^.framepointer]+')')
-       else
-       }
-         retstr:='';
-
-       c:=current_scanner.asmgetchar;
-       code:=TAAsmoutput.Create;
-       while not(ende) do
-         begin
-            { wrong placement
-            current_scanner.gettokenpos; }
-            case c of
-              'A'..'Z','a'..'z','_':
-                begin
-                   current_scanner.gettokenpos;
-                   i:=0;
-                   hs:='';
-                   while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
-                      or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
-                      or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
-                      or (c='_') do
-                     begin
-                        inc(i);
-                        hs[i]:=c;
-                        c:=current_scanner.asmgetchar;
-                     end;
-                   hs[0]:=chr(i);
-                   if upper(hs)='END' then
-                      ende:=true
-                   else
-                      begin
-                         if c=':' then
-                           begin
-                             searchsym(upper(hs),srsym,srsymtable);
-                             if srsym<>nil then
-                               if (srsym.typ = labelsym) then
-                                 Begin
-                                    hs:=tlabelsym(srsym).lab.name;
-                                    tlabelsym(srsym).lab.is_set:=true;
-                                 end
-                               else
-                                 Message(asmr_w_using_defined_as_local);
-                           end
-                         else
-                           { access to local variables }
-                           if assigned(aktprocdef) then
-                             begin
-                                { I don't know yet, what the ppc port requires }
-                                { we'll see how things settle down             }
-
-                                { is the last written character an special }
-                                { char ?                                   }
-                                { !!!
-                                if (s[length(s)]='%') and
-                                   ret_in_acc(aktprocdef.rettype.def) and
-                                   ((pos('AX',upper(hs))>0) or
-                                   (pos('AL',upper(hs))>0)) then
-                                  tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-                                }
-                                if ((s[length(s)]<>'0') or (hs[1]<>'x')) then
-                                  begin
-                                     if assigned(aktprocdef.localst) and
-                                        (lexlevel >= normal_function_level) then
-                                       sym:=tsym(aktprocdef.localst.search(upper(hs)))
-                                     else
-                                       sym:=nil;
-                                     if assigned(sym) then
-                                       begin
-                                          if (sym.typ=labelsym) then
-                                            Begin
-                                               hs:=tlabelsym(sym).lab.name;
-                                            end
-                                          else if sym.typ=varsym then
-                                            begin
-                                               if (vo_is_external in tvarsym(sym).varoptions) then
-                                                 hs:=tvarsym(sym).mangledname
-                                               else
-                                                 begin
-                                                    if (tvarsym(sym).reg<>R_NO) then
-                                                      hs:=gas_reg2str[procinfo.framepointer]
-                                                    else
-                                                      hs:=tostr(tvarsym(sym).address)+
-                                                        '('+gas_reg2str[procinfo.framepointer]+')';
-                                                 end;
-                                            end
-                                          else
-                                          { call to local function }
-                                          if (sym.typ=procsym) and (pos('BL',upper(s))>0) then
-                                            hs:=tprocsym(sym).first_procdef.mangledname;
-                                       end
-                                     else
-                                       begin
-                                          if assigned(aktprocdef.parast) then
-                                            sym:=tsym(aktprocdef.parast.search(upper(hs)))
-                                          else
-                                            sym:=nil;
-                                          if assigned(sym) then
-                                            begin
-                                               if sym.typ=varsym then
-                                                 begin
-                                                    l:=tvarsym(sym).address;
-                                                    { set offset }
-                                                    inc(l,aktprocdef.parast.address_fixup);
-                                                    hs:=tostr(l)+'('+gas_reg2str[procinfo.framepointer]+')';
-                                                    if pos(',',s) > 0 then
-                                                      tvarsym(sym).varstate:=vs_used;
-                                                 end;
-                                            end
-                                          { I added that but it creates a problem in line.ppi
-                                          because there is a local label wbuffer and
-                                          a static variable WBUFFER ...
-                                          what would you decide, florian ?}
-                                          else
-                                            begin
-                                               searchsym(upper(hs),sym,srsymtable);
-                                               if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
-                                                 begin
-                                                   case sym.typ of
-                                                     varsym :
-                                                       begin
-                                                         Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
-                                                         hs:=tvarsym(sym).mangledname;
-                                                         inc(tvarsym(sym).refs);
-                                                       end;
-                                                     typedconstsym :
-                                                       begin
-                                                         Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
-                                                         hs:=ttypedconstsym(sym).mangledname;
-                                                       end;
-                                                     procsym :
-                                                       begin
-                                                         { procs can be called or the address can be loaded }
-                                                         if (pos('BL',upper(s))>0) {or (pos('LEA',upper(s))>0))}  then
-                                                          begin
-                                                            if Tprocsym(sym).procdef_count>1 then
-                                                              Message1(asmr_w_direct_global_is_overloaded_func,hs);
-                                                            Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname);
-                                                            hs:=tprocsym(sym).first_procdef.mangledname;
-                                                          end;
-                                                       end;
-                                                     else
-                                                       Message(asmr_e_wrong_sym_type);
-                                                   end;
-                                                 end
-{$ifdef dummy}
-                                               else if upper(hs)='__SELF' then
-                                                 begin
-                                                    if assigned(procinfo^._class) then
-                                                      hs:=tostr(procinfo^.selfpointer_offset)+
-                                                          '('+gas_reg2str[procinfo^.framepointer]+')'
-                                                    else
-                                                     Message(asmr_e_cannot_use_SELF_outside_a_method);
-                                                 end
-                                               else if upper(hs)='__RESULT' then
-                                                 begin
-                                                    if (not is_void(aktprocdef.rettype.def)) then
-                                                      hs:=retstr
-                                                    else
-                                                      Message(asmr_e_void_function);
-                                                 end
-                                               { implement old stack/frame pointer access for nested procedures }
-                                               {!!!!
-                                               else if upper(hs)='__OLDSP' then
-                                                 begin
-                                                    { complicate to check there }
-                                                    { we do it: }
-                                                    if lexlevel>normal_function_level then
-                                                      hs:=tostr(procinfo^.framepointer_offset)+
-                                                        '('+gas_reg2str[procinfo^.framepointer]+')'
-                                                    else
-                                                      Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
-                                                 end;
-                                               }
-                                               end;
-{$endif dummy}
-                                            end;
-                                       end;
-                                  end;
-                             end;
-                         s:=s+hs;
-                      end;
-                end;
-              '{',';',#10,#13:
-                begin
-                   if pos(retstr,s) > 0 then
-                     tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
-                   writeasmline;
-                   c:=current_scanner.asmgetchar;
-                end;
-              #26:
-                Message(scan_f_end_of_file);
-              else
-                begin
-                  current_scanner.gettokenpos;
-                  inc(byte(s[0]));
-                  s[length(s)]:=c;
-                  c:=current_scanner.asmgetchar;
-                end;
-            end;
-         end;
-       writeasmline;
-       assemble:=casmnode.create(code);
-     end;
-
-{*****************************************************************************
-                                     Initialize
-*****************************************************************************}
-
-const
-  asmmode_ppc_direct_info : tasmmodeinfo =
-          (
-            id    : asmmode_direct;
-            idtxt : 'DIRECT'
-          );
-
-initialization
-  RegisterAsmMode(asmmode_ppc_direct_info);
-
-end.

compiler/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,aasmcpu,
-       { symtable }
-       symconst,symbase,symtype,symsym,symtable,
-       { pass 1 }
-       nbas,
-       { parser }
-       scanner
-       // ,rautils
-       ;
-
-    function assemble : tnode;
-     begin
-     end;
-
-Begin
-end.

compiler/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,
-       cpubase,
-       rgobj;
-
-     type
-       trgcpu = class(trgobj)
-         function getcpuregisterint(list: taasmoutput; reg: tregister): tregister; override;
-         procedure ungetregisterint(list: taasmoutput; reg: tregister); override;
-       end;
-
-  implementation
-
-    uses
-      cgobj;
-
-    function trgcpu.getcpuregisterint(list: taasmoutput; 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: taasmoutput; 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/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/compiler/aopt.pas

@@ -1,267 +0,0 @@
-{
-    Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains the interface routines between the code generator
-    and the optimizer.
-
-    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 aopt;
-
-{$i fpcdefs.inc}
-
-  Interface
-
-    Uses
-      aasmbase,aasmtai,aasmcpu,
-      aoptobj;
-
-    Type
-      TAsmOptimizer = class(TAoptObj)
-
-        { _AsmL is the PAasmOutpout list that has to be optimized }
-        Constructor create(_AsmL: taasmoutput); virtual;
-
-        { call the necessary optimizer procedures }
-        Procedure Optimize;
-        Destructor destroy;override;
-
-      private
-        procedure FindLoHiLabels;
-        Procedure BuildLabelTableAndFixRegAlloc;
-        procedure clear;
-        procedure pass_1;
-      End;
-
-    var
-      casmoptimizer : class of tasmoptimizer;
-
-    procedure Optimize(AsmL:taasmoutput);
-
-  Implementation
-
-    uses
-      globtype, globals,
-      aoptda,aoptcpu,aoptcpud;
-
-    Constructor TAsmOptimizer.create(_AsmL: taasmoutput);
-      Begin
-        inherited create(_asml,nil,nil,nil);
-      {setup labeltable, always necessary}
-        New(LabelInfo);
-      End;
-
-    procedure TAsmOptimizer.FindLoHiLabels;
-      { Walks through the paasmlist to find the lowest and highest label number.  }
-      { Returns the last Pai object of the current block                          }
-      Var LabelFound: Boolean;
-          p, prev: tai;
-      Begin
-        LabelInfo^.LowLabel := High(AWord);
-        LabelInfo^.HighLabel := 0;
-        LabelInfo^.LabelDif := 0;
-        LabelInfo^.LabelTable:=nil;
-        LabelFound := False;
-        P := BlockStart;
-        prev := p;
-        With LabelInfo^ Do
-          Begin
-            While Assigned(P) And
-                  ((P.typ <> Ait_Marker) Or
-                   (tai_Marker(P).Kind <> AsmBlockStart)) Do
-              Begin
-                If (p.typ = ait_label) Then
-                  If (tai_Label(p).l.is_used) Then
-                    Begin
-                      LabelFound := True;
-                      If (tai_Label(p).l.labelnr < LowLabel) Then
-                        LowLabel := tai_Label(p).l.labelnr;
-                      If (tai_Label(p).l.labelnr > HighLabel) Then
-                        HighLabel := tai_Label(p).l.labelnr
-                    End;
-                prev := p;
-                GetNextInstruction(p, p)
-              End;
-            if (prev.typ = ait_marker) and
-               (tai_marker(prev).kind = asmblockstart) then
-              blockend := prev
-            else blockend := nil;
-            If LabelFound
-              Then LabelDif := HighLabel-LowLabel+1
-              Else LabelDif := 0
-          End
-      End;
-
-    Procedure TAsmOptimizer.BuildLabelTableAndFixRegAlloc;
-    { Builds a table with the locations of the labels in the taasmoutput.       }
-    { Also fixes some RegDeallocs like "# %eax released; push (%eax)"           }
-    Var p, hp1, hp2: tai;
-        UsedRegs: TRegSet;
-    Begin
-      UsedRegs := [];
-      With LabelInfo^ Do
-        If (LabelDif <> 0) Then
-          Begin
-            GetMem(LabelTable, LabelDif*SizeOf(TLabelTableItem));
-            FillChar(LabelTable^, LabelDif*SizeOf(TLabelTableItem), 0);
-            p := BlockStart;
-            While (P <> BlockEnd) Do
-              Begin
-                Case p.typ Of
-                  ait_Label:
-                    If tai_label(p).l.is_used Then
-                      LabelTable^[tai_label(p).l.labelnr-LowLabel].PaiObj := p;
-                  ait_regAlloc:
-                    begin
-                    {!!!!!!!!!
-                      if tai_regalloc(p).ratype=ra_alloc then
-                        Begin
-                          If Not(tai_regalloc(p).Reg in UsedRegs) Then
-                            UsedRegs := UsedRegs + [tai_regalloc(p).Reg]
-                          Else
-                            Begin
-                              hp1 := p;
-                              hp2 := nil;
-                              While GetLastInstruction(hp1, hp1) And
-                                    Not(RegInInstruction(tai_regalloc(p).Reg, hp1)) Do
-                                hp2:=hp1;
-                              If hp2<>nil Then
-                                Begin
-                                  hp1:=tai_regalloc.DeAlloc(tai_regalloc(p).Reg,hp2);
-                                  InsertLLItem(tai(hp2.previous), hp2, hp1);
-                                End;
-                            End;
-                        End
-                      else
-                        Begin
-                          UsedRegs := UsedRegs - [tai_regalloc(p).Reg];
-                          hp1 := p;
-                          hp2 := nil;
-                          While Not(FindRegAlloc(tai_regalloc(p).Reg, tai(hp1.Next))) And
-                                GetNextInstruction(hp1, hp1) And
-                                RegInInstruction(tai_regalloc(p).Reg, hp1) Do
-                            hp2 := hp1;
-                          If hp2 <> nil Then
-                            Begin
-                              hp1 := tai(p.previous);
-                              AsmL.Remove(p);
-                              InsertLLItem(hp2, tai(hp2.Next), p);
-                              p := hp1;
-                            End
-                        End
-                    };
-                    End
-                End;
-                P := tai(p.Next);
-                While Assigned(p) and
-                      (p <> blockend) and
-                      (p.typ in (SkipInstr - [ait_regalloc])) Do
-                  P := tai(P.Next)
-              End;
-          End
-    End;
-
-    procedure tasmoptimizer.clear;
-      begin
-        if LabelInfo^.labeldif <> 0 then
-          begin
-            freemem(LabelInfo^.labeltable);
-            LabelInfo^.labeltable := nil;
-          end;
-      end;
-
-    procedure tasmoptimizer.pass_1;
-      begin
-        findlohilabels;
-        BuildLabelTableAndFixRegAlloc;
-      end;
-
-
-    Procedure TAsmOptimizer.Optimize;
-      Var
-        HP: tai;
-        pass: longint;
-      Begin
-        pass:=0;
-        BlockStart := tai(AsmL.First);
-        pass_1;
-        While Assigned(BlockStart) Do
-          Begin
-             if pass = 0 then
-               PrePeepHoleOpts;
-            { Peephole optimizations }
-             PeepHoleOptPass1;
-            { Only perform them twice in the first pass }
-             if pass = 0 then
-               PeepHoleOptPass1;
-            If (cs_slowoptimize in aktglobalswitches) Then
-              Begin
-//                DFA:=TAOptDFACpu.Create(AsmL,BlockStart,BlockEnd,LabelInfo);
-                { data flow analyzer }
-//                DFA.DoDFA;
-                { common subexpression elimination }
-      {          CSE;}
-              End;
-            { more peephole optimizations }
-      {      PeepHoleOptPass2;}
-            { if pass = last_pass then }
-            PostPeepHoleOpts;
-            { free memory }
-            clear;
-            { continue where we left off, BlockEnd is either the start of an }
-            { assembler block or nil}
-            BlockStart := BlockEnd;
-            While Assigned(BlockStart) And
-                  (BlockStart.typ = ait_Marker) And
-                  (tai_Marker(BlockStart).Kind = AsmBlockStart) Do
-              Begin
-               { we stopped at an assembler block, so skip it    }
-               While GetNextInstruction(BlockStart, BlockStart) And
-                     ((BlockStart.Typ <> Ait_Marker) Or
-                      (tai_Marker(Blockstart).Kind <> AsmBlockEnd)) Do;
-               { blockstart now contains a tai_marker(asmblockend) }
-               If GetNextInstruction(BlockStart, HP) And
-                  ((HP.typ <> ait_Marker) Or
-                   (Tai_Marker(HP).Kind <> AsmBlockStart)) Then
-               { There is no assembler block anymore after the current one, so }
-               { optimize the next block of "normal" instructions              }
-                 pass_1
-               { Otherwise, skip the next assembler block }
-               else
-                 blockStart := hp;
-              End
-          End;
-      End;
-
-    Destructor TAsmOptimizer.Destroy;
-      Begin
-        Dispose(LabelInfo)
-      End;
-
-
-    procedure Optimize(AsmL:taasmoutput);
-      var
-        p : TAsmOptimizer;
-      begin
-        p:=casmoptimizer.Create(AsmL);
-        p.Optimize;
-        p.free
-      end;
-
-
-end.

compiler/compiler/aoptbase.pas

@@ -1,257 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains the base of all optimizer related objects
-
-    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 aoptbase;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-      aasmbase,aasmcpu,aasmtai,
-      cpubase,
-      cgbase,
-      cgutils;
-
-    Type
-      { the number of tai objects processed by an optimizer object since the last
-        time a register was modified                                              }
-      { size at each dimension depends on the registers of this type }
-      TInstrSinceLastMod = Array[tregistertype] of pbyte;
-
-    { the TAopBase object implements the basic methods that most other }
-    { assembler optimizer objects require                              }
-    Type
-      TAoptBase = class
-        { processor independent methods }
-
-        constructor create; virtual;
-        destructor destroy;override;
-        { returns true if register Reg is used by instruction p1 }
-        Function RegInInstruction(Reg: TRegister; p1: tai): Boolean;
-        { returns true if register Reg occurs in operand op }
-        Function RegInOp(Reg: TRegister; const op: toper): Boolean;
-        { returns true if register Reg is used in the reference Ref }
-        Function RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
-
-        { returns true if the references are completely equal }
-        {Function RefsEqual(Const R1, R2: TReference): Boolean;}
-
-        { gets the next tai object after current that contains info relevant }
-        { to the optimizer in p1. If there is none, it returns false and     }
-        { sets p1 to nil                                                     }
-        Function GetNextInstruction(Current: tai; Var Next: tai): Boolean;
-        { gets the previous tai object after current that contains info  }
-        { relevant to the optimizer in last. If there is none, it retuns }
-        { false and sets last to nil                                     }
-        Function GetLastInstruction(Current: tai; Var Last: tai): Boolean;
-
-
-        { processor dependent methods }
-
-        { returns the maximum width component of Reg. Only has to be }
-        { overridden for the 80x86 (afaik)                           }
-        Function RegMaxSize(Reg: TRegister): TRegister; Virtual;
-        { returns true if Reg1 and Reg2 are of the samae width. Only has to }
-        { overridden for the 80x86 (afaik)                                  }
-        Function RegsSameSize(Reg1, Reg2: TRegister): Boolean; Virtual;
-        { returns whether P is a load instruction (load contents from a }
-        { memory location or (register) variable into a register)       }
-        Function IsLoadMemReg(p: tai): Boolean; Virtual;
-        { returns whether P is a load constant instruction (load a constant }
-        { into a register)                                                  }
-        Function IsLoadConstReg(p: tai): Boolean; Virtual;
-        { returns whether P is a store instruction (store contents from a }
-        { register to a memory location or to a (register) variable)      }
-        Function IsStoreRegMem(p: tai): Boolean; Virtual;
-
-        { create a paicpu Object that loads the contents of reg1 into reg2 }
-        Function a_load_reg_reg(reg1, reg2: TRegister): taicpu; Virtual;
-
-    end;
-
-
-  implementation
-
-    uses
-      globtype,globals, aoptcpub;
-
-  constructor taoptbase.create;
-    begin
-      inherited create;
-    end;
-
-
-  destructor taoptbase.destroy;
-    begin
-      inherited destroy;
-    end;
-
-
-  Function TAOptBase.RegInInstruction(Reg: TRegister; p1: tai): Boolean;
-    Var Count: AWord;
-        TmpResult: Boolean;
-    Begin
-      TmpResult := False;
-      Count := 0;
-      If (p1.typ = ait_instruction) Then
-        Repeat
-          TmpResult := RegInOp(Reg, PInstr(p1)^.oper[Count]^);
-          Inc(Count)
-        Until (Count = MaxOps) or TmpResult;
-      RegInInstruction := TmpResult
-    End;
-
-
-  Function TAOptBase.RegInOp(Reg: TRegister; const op: toper): Boolean;
-    Begin
-      Case op.typ Of
-        Top_Reg: RegInOp := Reg = op.reg;
-        Top_Ref: RegInOp := RegInRef(Reg, op.ref^)
-        Else RegInOp := False
-      End
-    End;
-
-
-  Function TAOptBase.RegInRef(Reg: TRegister; Const Ref: TReference): Boolean;
-  Begin
-    Reg := RegMaxSize(Reg);
-    RegInRef := (Ref.Base = Reg)
-  {$ifdef RefsHaveIndexReg}
-    Or (Ref.Index = Reg)
-  {$endif RefsHaveIndexReg}
-  End;
-
-  Function TAOptBase.GetNextInstruction(Current: tai; Var Next: tai): Boolean;
-  Begin
-    Repeat
-      Current := tai(Current.Next);
-      While Assigned(Current) And
-            ((Current.typ In SkipInstr) or
-{$ifdef SPARC}
-             ((Current.typ=ait_instruction) and
-              (taicpu(Current).opcode=A_NOP)
-             ) or
-{$endif SPARC}
-             ((Current.typ = ait_label) And
-              Not(Tai_Label(Current).l.is_used))) Do
-        Current := tai(Current.Next);
-      If Assigned(Current) And
-         (Current.typ = ait_Marker) And
-         (Tai_Marker(Current).Kind = NoPropInfoStart) Then
-        Begin
-          While Assigned(Current) And
-                ((Current.typ <> ait_Marker) Or
-                 (Tai_Marker(Current).Kind <> NoPropInfoEnd)) Do
-            Current := Tai(Current.Next);
-        End;
-    Until Not(Assigned(Current)) Or
-          (Current.typ <> ait_Marker) Or
-          (Tai_Marker(Current).Kind <> NoPropInfoEnd);
-    Next := Current;
-    If Assigned(Current) And
-       Not((Current.typ In SkipInstr) or
-           ((Current.typ = ait_label) And
-            Not(Tai_Label(Current).l.is_used)))
-      Then GetNextInstruction := True
-      Else
-        Begin
-          Next := Nil;
-          GetNextInstruction := False;
-        End;
-  End;
-
-  Function TAOptBase.GetLastInstruction(Current: tai; Var Last: tai): Boolean;
-  Begin
-    Repeat
-      Current := Tai(Current.previous);
-      While Assigned(Current) And
-            (((Current.typ = ait_Marker) And
-              Not(Tai_Marker(Current).Kind in [AsmBlockEnd,NoPropInfoEnd])) or
-             (Current.typ In SkipInstr) or
-             ((Current.typ = ait_label) And
-               Not(Tai_Label(Current).l.is_used))) Do
-        Current := Tai(Current.previous);
-      If Assigned(Current) And
-         (Current.typ = ait_Marker) And
-         (Tai_Marker(Current).Kind = NoPropInfoEnd) Then
-        Begin
-          While Assigned(Current) And
-                ((Current.typ <> ait_Marker) Or
-                 (Tai_Marker(Current).Kind <> NoPropInfoStart)) Do
-            Current := Tai(Current.previous);
-        End;
-    Until Not(Assigned(Current)) Or
-          (Current.typ <> ait_Marker) Or
-          (Tai_Marker(Current).Kind <> NoPropInfoStart);
-    If Not(Assigned(Current)) or
-       (Current.typ In SkipInstr) or
-       ((Current.typ = ait_label) And
-        Not(Tai_Label(Current).l.is_used)) or
-       ((Current.typ = ait_Marker) And
-        (Tai_Marker(Current).Kind = AsmBlockEnd))
-      Then
-        Begin
-          Last := Nil;
-          GetLastInstruction := False
-        End
-      Else
-        Begin
-          Last := Current;
-          GetLastInstruction := True;
-        End;
-  End;
-
-
-  { ******************* Processor dependent stuff *************************** }
-
-  Function TAOptBase.RegMaxSize(Reg: TRegister): TRegister;
-  Begin
-    RegMaxSize := Reg
-  End;
-
-  Function TAOptBase.RegsSameSize(Reg1, Reg2: TRegister): Boolean;
-  Begin
-    RegsSameSize := True
-  End;
-
-  Function TAOptBase.IsLoadMemReg(p: tai): Boolean;
-  Begin
-    Abstract
-  End;
-
-  Function TAOptBase.IsLoadConstReg(p: tai): Boolean;
-  Begin
-    Abstract
-  End;
-
-  Function TAOptBase.IsStoreRegMem(p: tai): Boolean;
-  Begin
-    Abstract
-  End;
-
-  Function TAoptBase.a_load_reg_reg(reg1, reg2: TRegister): taicpu;
-  Begin
-    Abstract
-  End;
-
-end.

compiler/compiler/aoptcs.pas

@@ -1,848 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains the common subexpression elimination object of the
-    assembler optimizer.
-
-    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 aoptcs;
-
-interface
-
-uses aasm, aoptcpu, aoptobj;
-
-{ ************************************************************************* }
-{ info about the equivalence of registers when comparing two code sequences }
-{ ************************************************************************* }
-
-  TRegInfo = Object(TAoptBaseCpu)
-    { registers encountered in the new and old sequence }
-    NewRegsEncountered, OldRegsEncountered,
-    { registers which only have been loaded for use as base or index in a }
-    { reference later on                                                  }
-    RegsLoadedForRef: TRegSet;
-    { to which register in the old sequence corresponds every register in }
-    { the new sequence                                                    }
-    New2OldReg: TRegArray;
-
-    Constructor init;
-    { clear all information store in the object }
-    Procedure Clear;
-    { the contents of OldReg in the old sequence are now being loaded into }
-    { NewReg in the new sequence                                           }
-    Procedure AddReg(OldReg, NewReg: TRegister); Virtual;
-    { the contents of OldOp in the old sequence are now being loaded into }
-    { NewOp in the new sequence. It is assumed that OldOp and NewOp are   }
-    { equivalent                                                          }
-    Procedure AddOp(const OldOp, NewOp:Toper);
-    { check if a register in the old sequence (OldReg) can be equivalent to }
-    { a register in the new sequence (NewReg) if the operation OpAct is     }
-    { performed on it. The RegInfo is updated (not necessary to call AddReg }
-    { afterwards)                                                           }
-    Function RegsEquivalent(OldReg, NewReg: TRegister; OpAct: TopAction):
-      Boolean;
-    { check if a reference in the old sequence (OldRef) can be equivalent   }
-    { to a reference in the new sequence (NewRef) if the operation OpAct is }
-    { performed on it. The RegInfo is updated (not necessary to call AddOp  }
-    { afterwards)                                                           }
-    Function RefsEquivalent(Const OldRef, NewRef: TReference; OpAct:
-      TOpAction): Boolean;
-    { check if an operand in the old sequence (OldOp) can be equivalent to }
-    { an operand in the new sequence (NewOp) if the operation OpAct is     }
-    { performed on it. The RegInfo is updated (not necessary to call AddOp }
-    { afterwards)                                                          }
-    Function OpsEquivalent(const OldOp, NewOp: toper; OpAct: TopAction):
-      Boolean;
-    { check if an instruction in the old sequence (OldP) can be equivalent  }
-    { to an instruction in the new sequence (Newp). The RegInfo is updated  }
-    Function InstructionsEquivalent(OldP, NewP: Pai): Boolean;
-  End;
-
-
-{ ************************************************************************* }
-{ *************** The common subexpression elimination object ************* }
-{ ************************************************************************* }
-
-Type TAoptCSE = Object(TAoptObj)
-       { returns true if the instruction p1 modifies the register Reg }
-       Function RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
-     End;
-
-Implementation
-
-{ ************************************************************************* }
-{ ******************************* TReginfo ******************************** }
-{ ************************************************************************* }
-
-Constructor TRegInfo.Init;
-Begin
-  Clear;
-End;
-
-Procedure TRegInfo.Clear;
-Begin
-  RegsLoadedForRef   := [];
-  NewRegsEncountered := [FRAME_POINTER_REG, STACK_POINTER_REG];
-  OldRegsEncountered := [FRAME_POINTER_REG, STACK_POINTER_REG];
-  New2OldReg[FRAME_POINTER_REG] := FRAME_POINTER_REG;
-  New2OldReg[STACK_POINTER_REG] := STACK_POINTER_REG;
-End;
-
-Procedure TRegInfo.AddReg(OldReg, NewReg: TRegister);
-{ updates the ???RegsEncountered and ???2???Reg fields of RegInfo. Assumes  }
-{ that OldReg and NewReg have the same size (has to be chcked in advance    }
-{ with RegsSameSize) and that neither equals R_NO                           }
-{ has to be overridden for architectures like the 80x86 when not all GP     }
-{ regs are of the same size                                                 }
-Begin
-  NewRegsEncountered := NewRegsEncountered + [NewReg];
-  OldRegsEncountered := OldRegsEncountered + [OldReg];
-  New2OldReg[NewReg] := OldReg;
-End;
-
-Procedure TRegInfo.AddOp(const OldOp, NewOp:Toper);
-Begin
-  Case OldOp.typ Of
-    Top_Reg:
-      If (OldOp.reg <> R_NO) Then
-        AddReg(OldOp.reg, NewOp.reg);
-    Top_Ref:
-      Begin
-        If OldOp.ref^.base <> R_NO Then
-          AddReg(OldOp.ref^.base, NewOp.ref^.base);
-{$ifdef RefsHaveIndexReg}
-        If OldOp.ref^.index <> R_NO Then
-          AddReg(OldOp.ref^.index, NewOp.ref^.index);
-{$endif RefsHaveIndexReg}
-      End;
-  End;
-End;
-
-Function TRegInfo.RegsEquivalent(OldReg, NewReg: TRegister;
-           OPAct: TOpAction): Boolean;
-Begin
-  If Not((OldReg = R_NO) Or (NewReg = R_NO)) Then
-    If RegsSameSize(OldReg, NewReg) Then
-{ here we always check for the 32 bit component, because it is possible    }
-{ that the 8 bit component has not been set, event though NewReg already   }
-{ has been processed. This happens if it has been compared with a register }
-{ that doesn't have an 8 bit component (such as EDI). In that case the 8   }
-{ bit component is still set to R_NO and the comparison in the Else-part   }
-{ will fail                                                                }
-      If (RegMaxSize(OldReg) in OldRegsEncountered) Then
-        If (RegMaxSize(NewReg) in NewRegsEncountered) Then
-          RegsEquivalent := (OldReg = New2OldReg[NewReg])
-{ If we haven't encountered the new register yet, but we have encountered }
-{ the old one already, the new one can only be correct if it's being      }
-{ written to (and consequently the old one is also being written to),     }
-{ otherwise                                                               }
-{                                                                         }
-{  movl -8(%ebp), %eax        and         movl -8(%ebp), %eax             }
-{  movl (%eax), %eax                      movl (%edx), %edx               }
-{                                                                         }
-{  are considered equivalent                                              }
-        Else
-          If (OpAct = OpAct_Write) Then
-            Begin
-              AddReg(OldReg, NewReg);
-              RegsEquivalent := True
-            End
-          Else Regsequivalent := False
-      Else
-        If Not(RegMaxSize(NewReg) in NewRegsEncountered) Then
-          Begin
-            AddReg(OldReg, NewReg);
-            RegsEquivalent := True
-          End
-        Else RegsEquivalent := False
-    Else RegsEquivalent := False
-  Else RegsEquivalent := OldReg = NewReg
-End;
-
-Function TRegInfo.RefsEquivalent(Const OldRef, NewRef: TReference;
-           OpAct: TOpAction): Boolean;
-Begin
-  If OldRef.is_immediate Then
-    RefsEquivalent := NewRef.is_immediate and (OldRef.Offset = NewRef.Offset)
-  Else
-    RefsEquivalent := (OldRef.Offset+OldRef.OffsetFixup =
-                         NewRef.Offset+NewRef.OffsetFixup) And
-                      RegsEquivalent(OldRef.Base, NewRef.Base, OpAct)
-{$ifdef RefsHaveindexReg}
-                      And RegsEquivalent(OldRef.Index, NewRef.Index, OpAct)
-{$endif RefsHaveIndexReg}
-{$ifdef RefsHaveScale}
-                      And (OldRef.ScaleFactor = NewRef.ScaleFactor)
-{$endif RefsHaveScale}
-                      And (OldRef.Symbol = NewRef.Symbol)
-{$ifdef RefsHaveSegment}
-                      And (OldRef.Segment = NewRef.Segment)
-{$endif RefsHaveSegment}
-                      ;
-End;
-
-Function TRegInfo.OpsEquivalent(const OldOp, NewOp: toper; OpAct: TopAction):
-           Boolean;
-Begin
-  OpsEquivalent := False;
-  if OldOp.typ=NewOp.typ then
-    Case OldOp.typ Of
-      Top_Const: OpsEquivalent := OldOp.val = NewOp.val;
-      Top_Reg: OpsEquivalent := RegsEquivalent(OldOp.reg,NewOp.reg, OpAct);
-      Top_Ref: OpsEquivalent := RefsEquivalent(OldOp.ref^, NewOp.ref^, OpAct);
-      Top_None: OpsEquivalent := True
-    End;
-End;
-
-Function TRegInfo.InstructionsEquivalent(OldP, NewP: Pai): Boolean;
-
-  Function OperandTypesEqual: Boolean;
-  Var Count: AWord;
-  Begin
-    OperandTypesEqual := False;
-    For Count := 0 to max_operands-1 Do
-      If (PInstr(OldP)^.oper[Count].typ <> PInstr(NewP)^.oper[Count].typ) Then
-        Exit;
-    OperandTypesEqual := True
-  End;
-
-Var Count: AWord;
-    TmpResult: Boolean;
-Begin
-  If Assigned(OldP) And Assigned(NewP) And
-     (Pai(OldP)^.typ = ait_instruction) And
-     (Pai(NewP)^.typ = ait_instruction) And
-     (PInstr(OldP)^.opcode = PInstr(NewP)^.opcode) And
-     OperandTypesEqual
-    Then
-{ both instructions have the same structure:                }
-{ "<operator> <operand of type1>, <operand of type 2>, ..." }
-      If IsLoadMemReg(OldP) Then
-{ then also NewP = loadmemreg because of the previous check }
-        If Not(RegInRef(PInstr(OldP)^.oper[LoadDst].reg,
-                 PInstr(OldP)^.oper[LoadSrc].ref^)) Then
-{ the "old" instruction is a load of a register with a new value, not with }
-{ a value based on the contents of this register (so no "mov (reg), reg")  }
-          If Not(RegInRef(PInstr(NewP)^.oper[LoadDst].reg,
-                          PInstr(NewP)^.oper[LoadSrc].ref^)) And
-             RefsEqual(PInstr(OldP)^.oper[LoadSrc].ref^,
-                       PInstr(NewP)^.oper[LoadSrc].ref^)
-            Then
-{ the "new" instruction is also a load of a register with a new value, and }
-{ this value is fetched from the same memory location                      }
-              Begin
-                With PInstr(NewP)^.oper[LoadSrc].ref^ Do
-                  Begin
-                    If Not(Base in [ProcInfo.FramePointer, R_NO, STACK_POINTER_REG])
-{ it won't do any harm if the register is already in RegsLoadedForRef }
-                      Then RegsLoadedForRef := RegsLoadedForRef + [Base];
-{$ifdef RefsHaveIndexReg}
-                    If Not(Index in [ProcInfo.FramePointer, R_NO, STACK_POINTER_REG])
-                      Then RegsLoadedForRef := RegsLoadedForRef + [Index];
-{$endif RefsHaveIndexReg}
-                  End;
-{ add the registers from the reference (.oper[Src]) to the RegInfo, all }
-{ registers from the reference are the same in the old and in the new   }
-{ instruction sequence (refsequal returned true)                        }
-                AddOp(PInstr(OldP)^.oper[LoadSrc], PInstr(OldP)^.oper[LoadSrc]);
-{ the registers from .oper[Dest] have to be equivalent, but not necessarily }
-{ equal                                                                     }
-                InstructionsEquivalent :=
-                  RegsEquivalent(PInstr(OldP)^.oper[LoadDst].reg,
-                                 PInstr(NewP)^.oper[LoadDst].reg, OpAct_Write);
-              End
-{ the registers are loaded with values from different memory locations. If }
-{ this were allowed, the instructions "mov -4(%esi),%eax" and              }
-{  "mov -4(%ebp),%eax" would be considered equivalent                      }
-            Else InstructionsEquivalent := False
-        Else
-{ load register with a value based on the current value of this register }
-          Begin
-            With PInstr(NewP)^.oper[0].ref^ Do
-{ Assume the registers occurring in the reference have only been loaded with }
-{ the value they contain now to calculate an address (so the value they have }
-{ now, won't be stored to memory later on)                                   }
-              Begin
-                If Not(Base in [ProcInfo.FramePointer,
-                                RegMaxSize(PInstr(NewP)^.oper[LoadDst].reg),
-                                R_NO,STACK_POINTER_REG])
-{ It won't do any harm if the register is already in RegsLoadedForRef }
-                  Then
-                    Begin
-                      RegsLoadedForRef := RegsLoadedForRef + [Base];
-{$ifdef csdebug}
-                      Writeln(std_reg2str[base], ' added');
-{$endif csdebug}
-                    end;
-{$Ifdef RefsHaveIndexReg}
-                If Not(Index in [ProcInfo.FramePointer,
-                                 RegMaxSize(PInstr(NewP)^.oper[LoadDst].reg),
-                                 R_NO,StackPtr])
-                  Then
-                    Begin
-                      RegsLoadedForRef := RegsLoadedForRef + [Index];
-{$ifdef csdebug}
-                      Writeln(std_reg2str[index], ' added');
-{$endif csdebug}
-                    end;
-{$endif RefsHaveIndexReg}
-              End;
-
-{ now, remove the destination register of the load from the                 }
-{ RegsLoadedForReg, since if it's loaded with a new value, it certainly     }
-{ will still be used later on                                               }
-            If Not(RegMaxSize(PInstr(NewP)^.oper[LoadDst].reg) In
-                [ProcInfo.FramePointer,R_NO,STACK_POINTER_REG])
-              Then
-                Begin
-                  RegsLoadedForRef := RegsLoadedForRef -
-                    [RegMaxSize(PInstr(NewP)^.oper[LoadDst].reg)];
-{$ifdef csdebug}
-                  Writeln(std_reg2str[RegMaxSize(PInstr(NewP)^.oper[1].reg)], ' removed');
-{$endif csdebug}
-                end;
-            InstructionsEquivalent :=
-               OpsEquivalent(PInstr(OldP)^.oper[LoadSrc],
-                             PInstr(NewP)^.oper[LoadSrc], OpAct_Read) And
-               OpsEquivalent(PInstr(OldP)^.oper[LoadDst],
-                             PInstr(NewP)^.oper[LoadDst], OpAct_Write)
-          End
-      Else
-{ OldP and NewP are not a load instruction, but have the same structure }
-{ (opcode, operand types), so they're equivalent if all operands are    }
-{ equivalent                                                            }
-       Begin
-         Count := 0;
-         TmpResult := true;
-         Repeat
-           TmpResult :=
-             OpsEquivalent(PInstr(OldP)^.oper[Count], PInstr(NewP)^.oper[Count],
-                           OpAct_Unknown);
-           Inc(Count)
-         Until (Count = MaxOps) or not(TmpResult);
-         InstructionsEquivalent := TmpResult
-       End
-{ the instructions haven't even got the same structure, so they're certainly }
-{ not equivalent                                                             }
-    Else InstructionsEquivalent := False;
-End;
-
-
-Function TRegInfo.CheckSequence(p: Pai; Reg: TRegister; Var Found: Longint):
-           Boolean;
-{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}
-
-{ note: the NrOfMods field can hold two deifferent values depending on      }
-{ which instruction it belongs to:                                          }
-{   * if it is the first instruction of a sequence that describes the       }
-{     contents of a register, NrOfMods contains how many instructions are   }
-{      in the sequence                                                      }
-{   * otherwise, NrOfMods contains how many instructions are in the         }
-{     describing the contents of the register after the current instruction }
-{     has been executed                                                     }
-
-Var oldp, newp: Pai;
-    PrevNonRemovablePai: Pai;
-    OrgRegInfo, HighRegInfo: PRegInfo;
-    HighFound, OrgRegFound: Byte;
-    RegCounter: TRegister;
-    OrgRegResult: Boolean;
-    TmpResult: Boolean;
-    OldNrOfMods: Byte;
-Begin {CheckSequence}
-  Reg := RegMaxSize(Reg);
-{ have we found a sequence of instructions equivalent to the new one? }
-  TmpResult := False;
-{ HighRegInfo will contain the RegInfo for the longest sequence of matching }
-{ instructions found                                                        }
-  New(HighRegInfo, Init);
-{ how many instructions are in the sequence describing the content of Reg }
-{ (the parameter) in the old sequence                                     }
-  OrgRegFound := 0;
-{ how many instructions are in the longest sequence of matching }
-{ instructions found until now?                                 }
-  HighFound := 0;
-{ does the content of Reg in the old equence match the content of Reg in }
-{ the new sequence                                                       }
-  OrgRegResult := False;
-  RegCounter := LoGPReg;
-{ PrevNonRemovablePai's OptInfo contains the contents of the registers   }
-{ before the current instruction is executed. It will be used to compare }
-{ the new contents with and to see whether the new instructions can be   }
-{ removed                                                                }
-  GetLastInstruction(p, PrevNonRemovablePai);
-{ don't check registers that only contain a constant or something unknown }
-  While (RegCounter <= HiGPReg And
-        (PPaiProp(PrevNonRemovablePai^.OptInfo)^.Regs[RegCounter].Typ <> Con_Ref) Do
-    Inc(RegCounter);
-  While (RegCounter <= HiGPReg) Do
-    Begin
-      { reinitialize the reginfo fields }
-      Init;
-      { no matching instructions found yet }
-      Found := 0;
-      With PPaiProp(PrevNonRemovablePai^.OptInfo)^.Regs[RegCounter] Do
-        Begin
-          { get the first instruction that describes the content of the }
-          { the register we're going to check the way it was before the }
-          { current instruction got executed                            }
-          oldp := StartMod;
-          { how many instructions describe the content of the register }
-          { before the current instructions got executed?              }
-          OldNrOfMods := NrOfMods
-        End;
-      { p is the first instruction that describes the content of Reg }
-      { after p (= the current instruction) got executed             }
-      newp := p;
-      { it's possible that the old contents of the current register are   }
-      { described by a sequence of instructions that also contains the    }
-      { one in parameter p. In that case, we have to compare until we     }
-      { encounter p. Otherwise, compare as much instructions as there are }
-      { in the old sequence or until there's a mismatch                   }
-      While  (p <> oldp) And
-             (Found < OldNrOfMods) And
-                                  { old  new }
-             InstructionsEquivalent(oldp, newp, RegInfo) Do
-        Begin
-          GetNextInstruction(oldp, oldp);
-          GetNextInstruction(newp, newp);
-          Inc(Found)
-        End;
-      If (Found < OldNrOfMods) Then
-        Begin
-          { the old sequence was longer than than the new one, so no match }
-          TmpResult := False;
-          { If there is no match, we have to set the CanBeRemoved flag of   }
-          { all pai objects part of the new sequence to false, because it's }
-          { possible that some of them have already been scheduled for      }
-          { removal after checking another sequence (an instruction can be  }
-          { of more than one sequence). If we return false, the number      }
-          { returned in found denotes how many instructions have to have    }
-          { their CanBeRemoved flag set to false                            }
-          { We only have to set those flags to false if their was a partial }
-          { match of instructions (found > 0), because otherwise they can't }
-          { have been set to true in a previous comparison                  }
-          If (found > 0) Then
-            Found := PPaiProp(Pai(p)^.OptInfo)^.Regs[Reg].NrOfMods
-        End
-      Else TmpResult := True;
-      If (RegCounter = Reg) Then
-        Begin
-          OrgRegFound := Found;
-          OrgRegResult := TmpResult;
-          New(OrgRegInfo, InitWithValue(RegInfo));
-        End
-      Else
-        If TmpResult And
-           (Found > HighFound) Then
-          Begin
-            HighFound := Found;
-            HighRegInfo^.InitWithValue(RegInfo);
-          End;
-      RegInfo.Done;
-      Repeat
-        Inc(RegCounter);
-      Until (RegCounter > HiGPReg) or
-            (PPaiProp(PrevNonRemovablePai^.OptInfo)^.Regs[RegCounter].Typ =
-              Con_Ref);
-    End;
-  If (HighFound > 0) And
-     (Not(OrgRegResult) Or
-      (HighFound > OrgRegFound)) Then
-    Begin
-      CheckSequence := True;
-      Found := HighFound
-      InitWithValue(HighRegInfo);
-    End
-  Else
-    Begin
-      CheckSequence := OrgRegResult;
-      Found := OrgRegFound;
-      InitWithValue(OrgRegInfo);
-    End;
-    Dispose(HighRegInfo, Done);
-    Dispose(OrgRegInfo, Done)
-End; {CheckSequence}
-
-
-{ ************************************************************************* }
-{ ******************************* TAOptCSE ******************************** }
-{ ************************************************************************* }
-
-
-Function TAOptCSE.RegModifiedByInstruction(Reg: TRegister; p1: Pai): Boolean;
-Var hp: Pai;
-Begin
-  If GetLastInstruction(p1, hp)
-    Then
-      RegModifiedByInstruction :=
-        PPAiProp(p1^.OptInfo)^.GetWState <>
-          PPAiProp(hp^.OptInfo)^.GetWState
-    Else RegModifiedByInstruction := True;
-End;
-
-Procedure TAoptCSE.RestoreContents(Current: Pai; Reg: TRegister);
-Var Prev, hp3, hp5: Pai;
-    TmpState: TStateInt;
-    Cnt, Cnt2: Byte;
-Begin
-{ load Cnt2 with the total number of instructions of this sequence }
-  Cnt2 := PPaiProp(Prev^.OptInfo)^.Regs[RegInfo.New2OldReg[reg]].
-    NrOfMods;
-{ sometimes, a register can not be removed from a sequence, because it's }
-{ still used afterwards:                                                 }
-{                                                                        }
-{ movl    -8(%ebp), %eax                        movl    -8(%ebp), %eax   }
-{ movl    70(%eax), %eax                        movl    70(%eax), %eax   }
-{ cmpl    74(%eax), %eax                        cmpl    74(%eax), %eax   }
-{ jne     l1               can't be changed to  jne     l1               }
-{ movl    -8(%ebp), %eax                                                 }
-{ movl    70(%eax), %edi                        movl    %eax, %edi       }
-{ boundl  R_282, %edi                           boundl  R_282, %edi      }
-{ pushl   70(%eax)                              pushl   70(%eax)         }
-{                                                                        }
-{ because eax now contains the wrong value when 70(%eax) is pushed       }
-
-{ start at the first instruction of the sequence }
-  hp3 := Current;
-  For Cnt := 1 to Pred(Cnt2) Do
-    GetNextInstruction(hp3, hp3);
-{ hp3 now containts the last instruction of the sequence }
-{ get the writestate at this point of the register in TmpState }
-  TmpState := PPaiProp(hp3^.OptInfo)^.GetWState(reg);
-{ hp3 := first instruction after the sequence }
-  GetNextInstruction(hp3, hp3);
-
-{ now, even though reg is in RegsLoadedForRef, sometimes it's still used  }
-{ afterwards. It is not if either it is not in usedregs anymore after the }
-{ sequence, or if it is loaded with a new value right after the sequence  }
-  If (TmpState <> PPaiProp(hp3^.OptInfo)^.Regs[reg].WState) Or
-     Not(reg in PPaiProp(hp3^.OptInfo)^.UsedRegs) Then
-{ the register is not used anymore after the sequence! }
-    Begin
-{$ifdef csdebug}
-      Writeln('Cnt2: ',Cnt2);
-      hp5 := new(pai_asm_comment,init(strpnew('starting here...')));
-      InsertLLItem(Pai(Current^.previous), Current, hp5);
-{$endif csdebug}
-      hp3 := Current;
-{ first change the contents of the register inside the sequence }
-      For Cnt := 1 to Cnt2 Do
-        Begin
- {save the WState of the last pai object of the sequence for later use}
-          TmpState := PPaiProp(hp3^.OptInfo)^.Regs[reg].WState;
-{$ifdef csdebug}
-          hp5 := new(pai_asm_comment,init(strpnew('WState for '+
-            std_reg2str[reg]+': '+tostr(tmpstate))));
-          InsertLLItem(hp3, pai(hp3^.next), hp5);
-{$endif csdebug}
-          PPaiProp(hp3^.OptInfo)^.Regs[reg] :=
-            PPaiProp(Prev^.OptInfo)^.Regs[reg];
-          GetNextInstruction(hp3, hp3);
-        End;
-{ here, hp3 = p = Pai object right after the sequence, TmpState = WState of }
-{ reg at the last Pai object of the sequence                                }
-      GetLastInstruction(hp3, hp3);
-{ now, as long as the register isn't modified after the sequence, set its }
-{ contents to what they were before the sequence                          }
-      While GetNextInstruction(hp3, hp3) And
-            (PPaiProp(hp3^.OptInfo)^.GetWState(Reg) = TmpState) Do
-{$ifdef csdebug}
-        begin
-          hp5 := new(pai_asm_comment,init(strpnew('WState for '+std_reg2str[reg]+': '+
-                 tostr(PPaiProp(hp3^.OptInfo)^.GetWState(reg)))));
-             InsertLLItem(hp3, pai(hp3^.next), hp5);
-{$endif csdebug}
-          PPaiProp(hp3^.OptInfo)^.Regs[reg] :=
-            PPaiProp(Prev^.OptInfo)^.Regs[reg];
-{$ifdef csdebug}
-        end;
-{$endif csdebug}
-    End
-  Else
-{ the register is still used after the sequence, so undelete all }
-{ instructions in the sequence that modify reg                   }
-    Begin
-{$ifdef csdebug}
-      Writeln('Got there for ',std_reg2str[reg]);
-{$endif csdebug}
-      hp3 := Current;
-      For Cnt := 1 to Cnt2 Do
-        Begin
-          If RegModifiedByInstruction(reg, hp3) Then
-            PPaiProp(hp3^.OptInfo)^.CanBeRemoved := False;
-          GetNextInstruction(hp3, hp3);
-        End;
-    End;
-{$ifdef csdebug}
-  hp5 := new(pai_asm_comment,init(strpnew('stopping here...')));
-  InsertLLItem(AsmL, hp3, pai(hp3^.next), hp5);
-{$endif csdebug}
-End;
-
-Procedure TAoptCSE.DoCSE;
-{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: Longint;
-    p, hp1, Current: Pai;
-    hp3, Prev: Pai;
-{$ifdef csdebug}
-    hp5: pai;
-{$endif csdebug}
-    RegInfo: TRegInfo;
-    RegCounter: TRegister;
-    TmpState: Byte;
-Begin
-  p := SkipHead(BlockStart);
-  While (p <> BlockEnd) Do
-    Begin
-      Case p^.typ Of
-        ait_instruction:
-          Begin
-{            Case PInstr(p)^.opcode Of
-              A_CLD: If GetLastInstruction(p, hp1) And
-                        (PPaiProp(hp1^.OptInfo)^.DirFlag = F_NotSet) Then
-                       PPaiProp(Pai(p)^.OptInfo)^.CanBeRemoved := True;}
-              If IsLoadMemReg(p) Then
-                Begin
-                  If (p = PPaiProp(p^.OptInfo)^.Regs[RegMaxSize(
-                       PInstr(p)^.oper[LoadDst].reg)].StartMod) And
-                     GetLastInstruction (p, hp1) And
-                     (hp1^.typ <> ait_marker) Then
-{so we don't try to check a sequence when p is the first instruction of the block}
-                    If CheckSequence(p, PInstr(p)^.oper[LoadDst].reg, Cnt) 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 either removed or marked as non-removable), 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                                                     }
-                        Current := p;
-                        Cnt2 := 1;
-{ after this while loop, if hp1 <> nil it will contain the pai object }
-{ that's the start of a sequence that's not completely checked yet    }
-                        While Cnt2 <= Cnt Do
-                          Begin
-                            If (hp1 = nil) And
-                               Not(RegInInstruction(
-                                     PInstr(Current)^.oper[LoadDst].reg,p) Or
-                                   RegInInstruction(RegMaxSize(PInstr(
-                                     Current)^.oper[LoadDst].reg), p)) And
-{ do not recheck a sequence if it's completely part of the one we just }
-{ checked                                                              }
-                               Not(IsLoadMemReg(p) And
-                                   (PPaiProp(p^.OptInfo)^.Regs[RegMaxSize(
-                                      PInstr(p)^.Oper[LoadDst].reg)]
-                                      .NrOfMods <= (Cnt - Cnt2 + 1))) Then
-                              hp1 := p;
-{$ifndef noremove}
-                            PPaiProp(p^.OptInfo)^.CanBeRemoved := True;
-{$endif noremove}
-                            Inc(Cnt2);
-                            GetNextInstruction(p, p);
-                          End;
-{ insert a marker noting that for the following instructions no PPaiProp's }
-{ (containing optimizer info) have been generated, so GetNext/             }
-{ LastInstruction will ignore them (it will use the original instructions) }
-                        hp3 := New(Pai_Marker,Init(NoPropInfoStart));
-                        InsertLLItem(Pai(Current^.Previous), Current, hp3);
-{ Prev is used to get the contents of the registers before the sequence }
-                        GetLastInstruction(Current, Prev);
-{ If some registers were different in the old and the new sequence, move }
-{  the contents of those old registers to the new ones, e.g.             }
-{                                                                        }
-{   mov mem1, reg1                        mov mem1, reg1                 }
-{   ...               can be changed to   ...                            }
-{   mov mem1, reg2                        mov reg1, reg2                 }
-
-{$IfDef CSDebug}
-                        For RegCounter := LoGPReg To HiGPReg Do
-                          If (RegCounter in RegInfo.RegsLoadedForRef) Then
-                            Begin
-                              hp5 := new(pai_asm_comment,init(strpnew(
-                                'New: '+std_reg2str[RegCounter]+', Old: '+
-                                std_reg2str[RegInfo.New2OldReg[RegCounter]])));
-                              InsertLLItem(AsmL, Pai(Current^.previous), Current, hp5);
-                            End;
-{$EndIf CSDebug}
-                        For RegCounter := LoGPReg to HiGPReg Do
-                          Begin
-{ if New2OldReg[RegCounter] = R_NO, it means this register doesn't appear }
-{ the new nor the old sequence                                            }
-                            If (RegInfo.New2OldReg[RegCounter] <> R_NO) Then
-{ if a register is in RegsLoadedForRef, it means this register was loaded }
-{ with a value only to function as a base or index in a reference. The    }
-{ practical upshot of this is that this value won't be used anymore later }
-{ on, so even if another register was used in the new sequence for this,  }
-{ we don't have to load it. E.g.                                          }
-{                                                                         }
-{ movl 8(%ebp), %eax                        "                             }
-{ movl 4(%eax), %eax                        "                             }
-{ movl (%eax), %edi                         "                             }
-{ movl %edi, 12(%ebp)                       "                             }
-{ ...                   can be changed to   "                             }
-{ movl 8(%ebp), %edx                                                      }
-{ movl 4(%edx), %edx                                                      }
-{ movl (%edx), %ebx                         movl %edi, %ebx               }
-{                                                                         }
-{ There is no need to also add a "movl %eax, %edx"                        }
-                              If Not(RegCounter In RegInfo.RegsLoadedForRef) And
-                                             {old reg              new reg}
-{ no need to reload the register if it's the same in the old and new }
-{ sequence                                                           }
-                                 (RegInfo.New2OldReg[RegCounter] <> RegCounter) Then
-
-                                Begin
-                                  hp3 := a_load_reg_reg(
-                                                 {old reg          new reg}
-                                    RegInfo.New2OldReg[RegCounter], RegCounter));
-                                  InsertLLItem(Pai(Current^.previous), Current, hp3);
-                                End
-                              Else
-{ As noted before, if a register is in RegsLoadedForRef, it doesn't have  }
-{ to be loaded. However, when data flow analyzer processed this code, the }
-{ was loaded, so we need to change that. This is done by setting the      }
-{ contents of the register to its contents before the new sequence, for   }
-{ every instruction until the first load of the register with a new value }
-                                If (RegCounter In RegInfo.RegsLoadedForRef) Then
-                                  RestoreOrigContents(Current, RegCounter);
-
-                          End;
-{ the end of the area where instructions without optimizer info can occur }
-                        hp3 := New(Pai_Marker,Init(NoPropInfoEnd));
-                        InsertLLItem(AsmL, Pai(Current^.Previous), Current, hp3);
-{ if we found an instruction sequence that needs complete re-evaluation, }
-{ process it                                                             }
-                        If hp1 <> nil Then p := hp1;
-                        Continue;
-                      End
-                    Else
-{ checksequence returned false. In that case, if the current instruction }
-{ was already deleted (as part of another sequence), we have to undelete }
-{ all instructions pertaining to the register whose sequence we just     }
-{ checked                                                                }
-                      If (Cnt > 0) And
-                         (PPaiProp(p^.OptInfo)^. Regs[RegMaxSize(PInstr(p)^.
-                            oper[LoadDst].reg)].Typ = Con_Ref) And
-                         (PPaiProp(p^.OptInfo)^.CanBeRemoved) Then
-                        Begin
-                          Current := p;
-                          Cnt2 := 1;
-                          While Cnt2 <= Cnt Do
-                            Begin
-                              If RegInInstruction(PInstr(Current)^.
-                                   oper[LoadDst].reg, p) Or
-                                 RegInInstruction(RegMaxSize(PInstr(Current)^.
-                                   oper[LoadDst].reg), p) Then
-                                PPaiProp(p^.OptInfo)^.CanBeRemoved := False;
-                              Inc(Cnt2);
-                              GetNextInstruction(p, p);
-                            End;
-                          Continue;
-                        End;
-                End
-              Else if IsLoadConstReg(p) Then
-                Begin
-                  If GetLastInstruction(p, hp1) Then
-                    With PPaiProp(hp1^.OptInfo)^.Regs[
-                           RegMaxSize(PInstr(p)^.oper[LoadDst].reg)] Do
-                      If (Typ = Con_Const) And
-                         (StartMod = p) Then
-                        PPaiProp(p^.OptInfo)^.CanBeRemoved := True;
-                End
-              Else
-                CpuCSE(p);
-{              A_STD: If GetLastInstruction(p, hp1) And
-                        (PPaiProp(hp1^.OptInfo)^.DirFlag = F_Set) Then
-                        PPaiProp(Pai(p)^.OptInfo)^.CanBeRemoved := True;
-              A_XOR:
-                Begin
-                  If (Paicpu(p)^.oper[0].typ = top_reg) And
-                     (Paicpu(p)^.oper[0].typ = top_reg) And
-                     (Paicpu(p)^.oper[1].reg = Paicpu(p)^.oper[1].reg) And
-                     GetLastInstruction(p, hp1) And
-                     (PPaiProp(hp1^.OptInfo)^.Regs[Reg32(Paicpu(p)^.oper[1].reg)].typ = con_const) And
-                     (PPaiProp(hp1^.OptInfo)^.Regs[Reg32(Paicpu(p)^.oper[1].reg)].StartMod = nil)
-                    Then PPaiProp(p^.OptInfo)^.CanBeRemoved := True
-                End
-          End;
-      End;
-      GetNextInstruction(p, p);
-    End;
-End;
-
-Procedure RemoveInstructs;
-{Removes the marked instructions and disposes the PPaiProps of the other
- instructions, restoring their line number}
-Var p, hp1: Pai;
-    InstrCnt: Longint;
-Begin
- p := SkipHead(BlockStart);
-  InstrCnt := 1;
-  While (p <> BlockEnd) Do
-    Begin
-{$ifndef noinstremove}
-      If PPaiProp(p^.OptInfo)^.CanBeRemoved
-        Then
-          Begin
-            Dispose(PPaiProp(p^.OptInfo));
-            GetNextInstruction(p, hp1);
-            AsmL^.Remove(p);
-            Dispose(p, Done);
-            p := hp1;
-            Inc(InstrCnt);
-          End
-        Else
-{$endif noinstremove}
-          Begin
-            Dispose(PPaiProp(p^.OptInfo));
-            p^.OptInfo := nil;
-            GetNextInstruction(p, p);
-            Inc(InstrCnt);
-          End;
-    End;
-End;
-
-Procedure TAoptCSE.CSE;
-Begin
-  DoCSE;
-  RemoveInstructs;
-End;
-
-
-
-End.

compiler/compiler/aoptda.pas

@@ -1,183 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains the data flow analyzer object of the assembler
-    optimizer.
-
-    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 aoptda;
-
-{$i fpcdefs.inc}
-
-  Interface
-
-    uses
-      cpubase,cgbase,
-      aasmbase,aasmtai,aasmcpu,
-      aoptcpub, aoptbase;
-
-    Type
-      TAOptDFA = class
-        { uses the same constructor as TAoptCpu = constructor from TAoptObj }
-
-        { gathers the information regarding the contents of every register }
-        { at the end of every instruction                                  }
-        Procedure DoDFA;
-
-        { handles the processor dependent dataflow analizing               }
-        Procedure CpuDFA(p: PInstr); Virtual;
-
-        { How many instructions are between the current instruction and the }
-        { last one that modified the register                               }
-        InstrSinceLastMod: TInstrSinceLastMod;
-
-        { convert a TInsChange value into the corresponding register }
-        //!!!!!!!!!! Function TCh2Reg(Ch: TInsChange): TRegister; Virtual;
-        { returns whether the instruction P reads from register Reg }
-        Function RegReadByInstr(Reg: TRegister; p: tai): Boolean; Virtual;
-      End;
-
-  Implementation
-
-    uses
-      globals, aoptobj;
-
-    Procedure TAOptDFA.DoDFA;
-    { Analyzes the Data Flow of an assembler list. Analyses the reg contents     }
-    { for the instructions between blockstart and blockend. Returns the last pai }
-    { which has been processed                                                   }
-    Var
-        CurProp: TPaiProp;
-        UsedRegs: TUsedRegs;
-        p, hp, NewBlockStart : tai;
-        TmpReg: TRegister;
-    Begin
-    {!!!!!!!!!!
-      p := BlockStart;
-      UsedRegs.Create;
-      UsedRegs.Update(p);
-      NewBlockStart := SkipHead(p);
-      { done implicitely by the constructor
-      FillChar(InstrSinceLastMod, SizeOf(InstrSinceLastMod), 0); }
-      While (P <> BlockEnd) Do
-        Begin
-          CurProp:=TPaiProp.Create;
-          If (p <> NewBlockStart) Then
-            Begin
-              GetLastInstruction(p, hp);
-              CurProp.Regs := TPaiProp(hp.OptInfo).Regs;
-    { !!!!!!!!!!!! }
-    {$ifdef x86}
-              CurProp.CondRegs.Flags :=
-                TPaiProp(hp.OptInfo).CondRegs.Flags;
-    {$endif}
-            End;
-          CurProp.UsedRegs.InitWithValue(UsedRegs.GetUsedRegs);
-          UsedRegs.Update(tai(p.Next));
-          TPaiProp(p.OptInfo) := CurProp;
-          For TmpReg := LoGPReg To HiGPReg Do
-            Inc(InstrSinceLastMod[TmpReg]);
-          Case p^.typ Of
-            ait_label:
-              If (Pai_label(p)^.l^.is_used) Then
-                CurProp^.DestroyAllRegs(InstrSinceLastMod);
-            ait_stab, ait_force_line, ait_function_name:;
-            ait_instruction:
-              if not(PInstr(p)^.is_jmp) then
-                begin
-                  If IsLoadMemReg(p) Then
-                    Begin
-                      CurProp^.ReadRef(PInstr(p)^.oper[LoadSrc].ref);
-                      TmpReg := RegMaxSize(PInstr(p)^.oper[LoadDst].reg);
-                      If RegInRef(TmpReg, PInstr(p)^.oper[LoadSrc].ref^) And
-                         (CurProp^.GetRegContentType(TmpReg) = Con_Ref) Then
-                        Begin
-                          { a load based on the value this register already }
-                          { contained                                       }
-                          With CurProp^.Regs[TmpReg] Do
-                            Begin
-                              CurProp^.IncWState(TmpReg);
-                               {also store how many instructions are part of the  }
-                               { sequence in the first instruction's PPaiProp, so }
-                               { it can be easily accessed from within            }
-                               { CheckSequence                                    }
-                              Inc(NrOfMods, InstrSinceLastMod[TmpReg]);
-                              PPaiProp(Pai(StartMod)^.OptInfo)^.Regs[TmpReg].NrOfMods := NrOfMods;
-                              InstrSinceLastMod[TmpReg] := 0
-                            End
-                        End
-                      Else
-                        Begin
-                          { load of a register with a completely new value }
-                          CurProp^.DestroyReg(TmpReg, InstrSinceLastMod);
-                          If Not(RegInRef(TmpReg, PInstr(p)^.oper[LoadSrc].ref^)) Then
-                            With CurProp^.Regs[TmpReg] Do
-                              Begin
-                                Typ := Con_Ref;
-                                StartMod := p;
-                                NrOfMods := 1;
-                              End
-                        End;
-      {$ifdef StateDebug}
-                        hp := new(pai_asm_comment,init(strpnew(std_reg2str[TmpReg]+': '+tostr(CurProp^.Regs[TmpReg].WState))));
-                        InsertLLItem(AsmL, p, p^.next, hp);
-      {$endif StateDebug}
-
-                    End
-                  Else if IsLoadConstReg(p) Then
-                    Begin
-                      TmpReg := RegMaxSize(PInstr(p)^.oper[LoadDst].reg);
-                      With CurProp^.Regs[TmpReg] Do
-                        Begin
-                          CurProp^.DestroyReg(TmpReg, InstrSinceLastMod);
-                          typ := Con_Const;
-                          StartMod := Pointer(PInstr(p)^.oper[LoadSrc].val);
-                        End
-                    End
-                  Else CpuDFA(Pinstr(p));
-                End;
-            Else CurProp^.DestroyAllRegs(InstrSinceLastMod);
-          End;
-    {      Inc(InstrCnt);}
-          GetNextInstruction(p, p);
-        End;
-    }
-    End;
-
-    Procedure TAoptDFA.CpuDFA(p: PInstr);
-    Begin
-      Abstract;
-    End;
-
-  {!!!!!!!
-    Function TAOptDFA.TCh2Reg(Ch: TInsChange): TRegister;
-    Begin
-      TCh2Reg:=R_NO;
-      Abstract;
-    End;
-  }
-
-    Function TAOptDFA.RegReadByInstr(Reg: TRegister; p: tai): Boolean;
-    Begin
-      RegReadByInstr:=false;
-      Abstract;
-    End;
-
-
-End.

compiler/compiler/aoptobj.pas

@@ -1,1125 +0,0 @@
-{
-    Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit contains the processor independent assembler optimizer
-    object, base for the dataflow analyzer, peepholeoptimizer and
-    common subexpression elimination objects.
-
-    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 AoptObj;
-
-  {$i fpcdefs.inc}
-
-  { general, processor independent objects for use by the assembler optimizer }
-
-  Interface
-
-    uses
-      globtype,
-      aasmbase,aasmcpu,aasmtai,
-      cclasses,
-      cgbase,cgutils,
-      cpubase,
-      aoptbase,aoptcpub,aoptda;
-
-    { ************************************************************************* }
-    { ********************************* Constants ***************************** }
-    { ************************************************************************* }
-
-    Const
-
-    {Possible register content types}
-      con_Unknown = 0;
-      con_ref = 1;
-      con_const = 2;
-
-    {***************** Types ****************}
-
-    Type
-
-    { ************************************************************************* }
-    { ************************* Some general type definitions ***************** }
-    { ************************************************************************* }
-      TRefCompare = Function(r1, r2: TReference): Boolean;
-      //!!! FIXME
-      TRegArray = Array[byte] of tsuperregister;
-      TRegSet = Set of byte;
-    { possible actions on an operand: read, write or modify (= read & write) }
-      TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown);
-
-    { ************************************************************************* }
-    { * Object to hold information on which regiters are in use and which not * }
-    { ************************************************************************* }
-      TUsedRegs = class
-        Constructor create;
-        Constructor create_regset(Const _RegSet: TRegSet);
-
-        Destructor Destroy;override;
-        { update the info with the pairegalloc objects coming after }
-        { p                                                         }
-        Procedure Update(p: Tai);
-        { is Reg currently in use }
-        Function IsUsed(Reg: TRegister): Boolean;
-        { get all the currently used registers }
-        Function GetUsedRegs: TRegSet;
-
-      Private
-
-        UsedRegs: TRegSet;
-      End;
-
-    { ************************************************************************* }
-    { ******************* Contents of the integer registers ******************* }
-    { ************************************************************************* }
-
-     { size of the integer that holds the state number of a register. Can be any }
-     { integer type, so it can be changed to reduce the size of the TContent     }
-     { structure or to improve alignment                                         }
-      TStateInt = Byte;
-
-      TContent = Record
-        { start and end of block instructions that defines the }
-        { content of this register. If Typ = con_const, then   }
-        { Longint(StartMod) = value of the constant)           }
-        StartMod: Tai;
-        { starts at 0, gets increased everytime the register is }
-        { written to                                            }
-        WState: TStateInt;
-        { starts at 0, gets increased everytime the register is read }
-        { from                                                       }
-        RState: TStateInt;
-        { how many instructions starting with StarMod does the block }
-        { consist of                                                 }
-        NrOfMods: Byte;
-        { the type of the content of the register: unknown, memory   }
-        { (variable) or constant                                     }
-        Typ: Byte;
-      End;
-
-      //!!! FIXME
-      TRegContent = Array[byte] Of TContent;
-
-    { ************************************************************************** }
-    { information object with the contents of every register. Every Tai object   }
-    { gets one of these assigned: a pointer to it is stored in the OptInfo field }
-    { ************************************************************************** }
-
-      TPaiProp = class(TAoptBaseCpu)
-        Regs: TRegContent;
-        { info about allocation of general purpose integer registers }
-        UsedRegs: TUsedRegs;
-        { can this instruction be removed? }
-        CanBeRemoved: Boolean;
-
-        Constructor create;
-
-        { checks the whole sequence of which (so regs[which].StartMod and and  }
-        { the next NrOfMods Tai objects) to see whether Reg is used somewhere, }
-        { without it being loaded with something else first                    }
-        Function RegInSequence(Reg, which: TRegister): Boolean;
-        { destroy the contents of a register, as well as those whose contents }
-        { are based on those of that register                                 }
-        Procedure DestroyReg(Reg: TRegister; var InstrSinceLastMod:
-          TInstrSinceLastMod);
-        { if the contents of WhichReg (can be R_NO in case of a constant) are  }
-        { written to memory at the location Ref, the contents of the registers }
-        { that depend on Ref have to be  destroyed                             }
-        Procedure DestroyRefs(Const Ref: TReference; WhichReg: TRegister; var
-          InstrSinceLastMod: TInstrSinceLastMod);
-
-        { an instruction reads from operand o }
-        Procedure ReadOp(const o:toper);
-        { an instruction reads from reference Ref }
-        Procedure ReadRef(Ref: PReference);
-        { an instruction reads from register Reg }
-        Procedure ReadReg(Reg: TRegister);
-
-        { an instruction writes/modifies operand o and this has special     }
-        { side-effects or modifies the contents in such a way that we can't }
-        { simply add this instruction to the sequence of instructions that  }
-        { describe the contents of the operand, so destroy it               }
-        Procedure DestroyOp(const o:Toper; var InstrSinceLastMod:
-          TInstrSinceLastMod);
-        { destroy the contents of all registers }
-        Procedure DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
-        { a register's contents are modified, but not destroyed (the new value }
-        { depends on the old one)                                              }
-        Procedure ModifyReg(reg: TRegister; var InstrSinceLastMod:
-          TInstrSinceLastMod);
-        { an operand's contents are modified, but not destroyed (the new value }
-        { depends on the old one)                                              }
-        Procedure ModifyOp(const oper: TOper; var InstrSinceLastMod:
-          TInstrSinceLastMod);
-
-        { increase the write state of a register (call every time a register is }
-        { written to)                                                           }
-        Procedure IncWState(Reg: TRegister);
-        { increase the read state of a register (call every time a register is }
-        { read from)                                                           }
-        Procedure IncRState(Reg: TRegister);
-        { get the write state of a register }
-        Function GetWState(Reg: TRegister): TStateInt;
-        { get the read state of a register }
-        Function GetRState(Reg: TRegister): TStateInt;
-
-        { get the type of contents of a register }
-        Function GetRegContentType(Reg: TRegister): Byte;
-
-        Destructor Done;
-
-        Private
-
-        Procedure IncState(var s: TStateInt);
-
-        { returns whether the reference Ref is used somewhere in the loading }
-        { sequence Content                                                   }
-        Function RefInSequence(Const Ref: TReference; Content: TContent;
-          RefsEq: TRefCompare): Boolean;
-
-        { returns whether the instruction P reads from and/or writes }
-        { to Reg                                                     }
-        Function RefInInstruction(Const Ref: TReference; p: Tai;
-          RefsEq: TRefCompare): Boolean;
-
-        { returns whether two references with at least one pointing to an array }
-        { may point to the same memory location                                 }
-
-      End;
-
-
-    { ************************************************************************* }
-    { ************************ Label information ****************************** }
-    { ************************************************************************* }
-      TLabelTableItem = Record
-        PaiObj: Tai;
-      End;
-
-    {$ifndef TP}
-      TLabelTable = Array[0..2500000] Of TLabelTableItem;
-    {$else TP}
-      TLabelTable = Array[0..(65520 div sizeof(TLabelTableItem))] Of TLabelTableItem;
-    {$endif TP}
-      PLabelTable = ^TLabelTable;
-      PLabelInfo = ^TLabelInfo;
-      TLabelInfo = Record
-        { the highest and lowest label number occurring in the current code }
-        { fragment                                                          }
-        LowLabel, HighLabel: AWord;
-        LabelDif: AWord;
-        { table that contains the addresses of the Pai_Label objects associated
-          with each label number                                                }
-        LabelTable: PLabelTable;
-      End;
-
-    { ************************************************************************* }
-    { ********** General optimizer object, used to derive others from ********* }
-    { ************************************************************************* }
-
-      TAOptObj = class(TAoptBaseCpu)
-        { the PAasmOutput list this optimizer instance works on }
-        AsmL: TAasmOutput;
-
-        { The labelinfo record contains the addresses of the Tai objects }
-        { that are labels, how many labels there are and the min and max }
-        { label numbers                                                  }
-        LabelInfo: PLabelInfo;
-
-        { Start and end of the block that is currently being optimized }
-        BlockStart, BlockEnd: Tai;
-
-        DFA: TAOptDFA;
-        { _AsmL is the PAasmOutpout list that has to be optimized,     }
-        { _BlockStart and _BlockEnd the start and the end of the block }
-        { that has to be optimized and _LabelInfo a pointer to a       }
-        { TLabelInfo record                                            }
-        Constructor create(_AsmL: TAasmOutput; _BlockStart, _BlockEnd: Tai;
-                           _LabelInfo: PLabelInfo); virtual;
-
-        { processor independent methods }
-
-        { returns true if the label L is found between hp and the next }
-        { instruction                                                  }
-        Function FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
-
-        { inserts new_one between prev and foll in AsmL }
-        Procedure InsertLLItem(prev, foll, new_one: TLinkedListItem);
-
-
-        { If P is a Tai object releveant to the optimizer, P is returned
-          If it is not relevant tot he optimizer, the first object after P
-          that is relevant is returned                                     }
-        Function SkipHead(P: Tai): Tai;
-
-        { returns true if the operands o1 and o2 are completely equal }
-        Function OpsEqual(const o1,o2:toper): Boolean;
-
-        { Returns true if a ait_alloc object for Reg is found in the block
-          of Tai's starting with StartPai and ending with the next "real"
-          instruction                                                      }
-        Function FindRegAlloc(Reg: TRegister; StartPai: Tai): Boolean;
-
-       { traces sucessive jumps to their final destination and sets it, e.g.
-         je l1                je l3
-         <code>               <code>
-         l1:       becomes    l1:
-         je l2                je l3
-         <code>               <code>
-         l2:                  l2:
-         jmp l3               jmp l3
-
-         the level parameter denotes how deeep we have already followed the jump,
-         to avoid endless loops with constructs such as "l5: ; jmp l5"           }
-        function GetFinalDestination(hp: taicpu; level: longint): boolean;
-
-        function getlabelwithsym(sym: tasmlabel): tai;
-
-        { peephole optimizer }
-        procedure PrePeepHoleOpts;
-        procedure PeepHoleOptPass1;
-        procedure PeepHoleOptPass2;
-        procedure PostPeepHoleOpts;
-
-        { processor dependent methods }
-        // if it returns true, perform a "continue"
-        function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual;
-        function PostPeepHoleOptsCpu(var p: tai): boolean; virtual;
-      End;
-
-       Function ArrayRefsEq(const r1, r2: TReference): Boolean;
-
-    { ***************************** Implementation **************************** }
-
-  Implementation
-
-    uses
-      globals,
-      verbose,
-      procinfo;
-
-      { ************************************************************************* }
-      { ******************************** TUsedRegs ****************************** }
-      { ************************************************************************* }
-
-      Constructor TUsedRegs.create;
-      Begin
-        UsedRegs := [];
-      End;
-
-      Constructor TUsedRegs.create_regset(Const _RegSet: TRegSet);
-      Begin
-        UsedRegs := _RegSet;
-      End;
-
-      Procedure TUsedRegs.Update(p: Tai);
-      {updates UsedRegs with the RegAlloc Information coming after P}
-      Begin
-        Repeat
-          While Assigned(p) And
-                ((p.typ in (SkipInstr - [ait_RegAlloc])) or
-                 ((p.typ = ait_label) And
-                  Not(Tai_Label(p).l.is_used))) Do
-               p := Tai(p.next);
-          While Assigned(p) And
-                (p.typ=ait_RegAlloc) Do
-            Begin
-          {!!!!!!!! FIXME
-              if tai_regalloc(p).ratype=ra_alloc then
-                UsedRegs := UsedRegs + [tai_regalloc(p).Reg]
-              else
-                UsedRegs := UsedRegs - [tai_regalloc(p).Reg];
-              p := Tai(p.next);
-          }
-            End;
-        Until Not(Assigned(p)) Or
-              (Not(p.typ in SkipInstr) And
-               Not((p.typ = ait_label) And
-                  Not(Tai_Label(p).l.is_used)));
-      End;
-
-      Function TUsedRegs.IsUsed(Reg: TRegister): Boolean;
-      Begin
-        //!!!!!!!!!!! IsUsed := Reg in UsedRegs
-      End;
-
-      Function TUsedRegs.GetUsedRegs: TRegSet;
-      Begin
-        GetUsedRegs := UsedRegs;
-      End;
-
-      Destructor TUsedRegs.Destroy;
-        Begin
-          inherited destroy;
-        end;
-
-      { ************************************************************************* }
-      { **************************** TPaiProp *********************************** }
-      { ************************************************************************* }
-
-      Constructor TPaiProp.Create;
-        Begin
-        {!!!!!!
-          UsedRegs.Init;
-          CondRegs.init;
-        }
-        {  DirFlag: TFlagContents; I386 specific}
-        End;
-
-      Function TPaiProp.RegInSequence(Reg, which: TRegister): Boolean;
-      Var p: Tai;
-          RegsChecked: TRegSet;
-          content: TContent;
-          Counter: Byte;
-          TmpResult: Boolean;
-      Begin
-      {!!!!!!!!!!1
-        RegsChecked := [];
-        content := regs[which];
-        p := content.StartMod;
-        TmpResult := False;
-        Counter := 1;
-        While Not(TmpResult) And
-              (Counter <= Content.NrOfMods) Do
-          Begin
-            If IsLoadMemReg(p) Then
-              With PInstr(p)^.oper[LoadSrc]^.ref^ Do
-                If (Base = ProcInfo.FramePointer)
-      {$ifdef RefsHaveIndexReg}
-                   And (Index = R_NO)
-      {$endif RefsHaveIndexReg} Then
-                  Begin
-                    RegsChecked := RegsChecked +
-                      [RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg)];
-                    If Reg = RegMaxSize(PInstr(p)^.oper[LoadDst]^.reg) Then
-                      Break;
-                  End
-                Else
-                  Begin
-                    If (Base = Reg) And
-                       Not(Base In RegsChecked)
-                      Then TmpResult := True;
-      {$ifdef RefsHaveIndexReg}
-                    If Not(TmpResult) And
-                       (Index = Reg) And
-                         Not(Index In RegsChecked)
-                      Then TmpResult := True;
-      {$Endif RefsHaveIndexReg}
-                  End
-            Else TmpResult := RegInInstruction(Reg, p);
-            Inc(Counter);
-            GetNextInstruction(p,p)
-          End;
-        RegInSequence := TmpResult
-      }
-      End;
-
-
-      Procedure TPaiProp.DestroyReg(Reg: TRegister; var InstrSinceLastMod:
-                  TInstrSinceLastMod);
-      { Destroys the contents of the register Reg in the PPaiProp p1, as well as }
-      { the contents of registers are loaded with a memory location based on Reg }
-      Var TmpWState, TmpRState: Byte;
-          Counter: TRegister;
-      Begin
-      {!!!!!!!
-        Reg := RegMaxSize(Reg);
-        If (Reg in [LoGPReg..HiGPReg]) Then
-          For Counter := LoGPReg to HiGPReg Do
-            With Regs[Counter] Do
-              If (Counter = reg) Or
-                 ((Typ = Con_Ref) And
-                  RegInSequence(Reg, Counter)) Then
-                Begin
-                  InstrSinceLastMod[Counter] := 0;
-                  IncWState(Counter);
-                  TmpWState := GetWState(Counter);
-                  TmpRState := GetRState(Counter);
-                  FillChar(Regs[Counter], SizeOf(TContent), 0);
-                  WState := TmpWState;
-                  RState := TmpRState
-                End
-      }
-      End;
-
-      Function ArrayRefsEq(const r1, r2: TReference): Boolean;
-      Begin
-      {!!!!!!!!!!
-        ArrayRefsEq := (R1.Offset+R1.OffsetFixup = R2.Offset+R2.OffsetFixup) And
-      {$ifdef refsHaveSegmentReg}
-                       (R1.Segment = R2.Segment) And
-      {$endif}
-                       (R1.Base = R2.Base) And
-                       (R1.Symbol=R2.Symbol);
-      }
-      End;
-
-      Procedure TPaiProp.DestroyRefs(Const Ref: TReference; WhichReg: TRegister;
-                  var InstrSinceLastMod: TInstrSinceLastMod);
-      { destroys all registers which possibly contain a reference to Ref, WhichReg }
-      { is the register whose contents are being written to memory (if this proc   }
-      { is called because of a "mov?? %reg, (mem)" instruction)                    }
-      Var RefsEq: TRefCompare;
-          Counter: TRegister;
-      Begin
-      {!!!!!!!!!!!
-        WhichReg := RegMaxSize(WhichReg);
-        If (Ref.base = procinfo.FramePointer) or
-            Assigned(Ref.Symbol) Then
-          Begin
-            If
-      {$ifdef refsHaveIndexReg}
-               (Ref.Index = R_NO) And
-      {$endif refsHaveIndexReg}
-               (Not(Assigned(Ref.Symbol)) or
-                (Ref.base = R_NO)) Then
-        { local variable which is not an array }
-              RefsEq := {$ifdef fpc}@{$endif}RefsEqual
-            Else
-        { local variable which is an array }
-              RefsEq := {$ifdef fpc}@{$endif}ArrayRefsEq;
-      {write something to a parameter, a local or global variable, so
-         * with uncertain optimizations on:
-            - destroy the contents of registers whose contents have somewhere a
-              "mov?? (Ref), %reg". WhichReg (this is the register whose contents
-              are being written to memory) is not destroyed if it's StartMod is
-              of that form and NrOfMods = 1 (so if it holds ref, but is not a
-              pointer or value based on Ref)
-          * with uncertain optimizations off:
-             - also destroy registers that contain any pointer}
-            For Counter := LoGPReg to HiGPReg Do
-              With Regs[Counter] Do
-                Begin
-                  If (typ = Con_Ref) And
-                     ((Not(cs_UncertainOpts in aktglobalswitches) And
-                       (NrOfMods <> 1)
-                      ) Or
-                      (RefInSequence(Ref,Regs[Counter], RefsEq) And
-                       ((Counter <> WhichReg) Or
-                        ((NrOfMods <> 1) And
-       {StarMod is always of the type ait_instruction}
-                         (PInstr(StartMod)^.oper[0].typ = top_ref) And
-                         RefsEq(PInstr(StartMod)^.oper[0].ref^, Ref)
-                        )
-                       )
-                      )
-                     )
-                    Then
-                      DestroyReg(Counter, InstrSinceLastMod)
-                End
-          End
-        Else
-      {write something to a pointer location, so
-         * with uncertain optimzations on:
-            - do not destroy registers which contain a local/global variable or a
-              parameter, except if DestroyRefs is called because of a "movsl"
-         * with uncertain optimzations off:
-            - destroy every register which contains a memory location
-            }
-            For Counter := LoGPReg to HiGPReg Do
-              With Regs[Counter] Do
-                If (typ = Con_Ref) And
-                   (Not(cs_UncertainOpts in aktglobalswitches) Or
-      {$ifdef x86}
-              {for movsl}
-                    (Ref.Base = R_EDI) Or
-      {$endif}
-              {don't destroy if reg contains a parameter, local or global variable}
-                    Not((NrOfMods = 1) And
-                        (PInstr(StartMod)^.oper[0].typ = top_ref) And
-                        ((PInstr(StartMod)^.oper[0].ref^.base = ProcInfo.FramePointer) Or
-                          Assigned(PInstr(StartMod)^.oper[0].ref^.Symbol)
-                        )
-                       )
-                   )
-                Then DestroyReg(Counter, InstrSinceLastMod)
-      }
-      End;
-
-      Procedure TPaiProp.DestroyAllRegs(var InstrSinceLastMod: TInstrSinceLastMod);
-      Var Counter: TRegister;
-      Begin {initializes/desrtoys all registers}
-      {!!!!!!!!!
-        For Counter := LoGPReg To HiGPReg Do
-          Begin
-            ReadReg(Counter);
-            DestroyReg(Counter, InstrSinceLastMod);
-          End;
-        CondRegs.Init;
-      { FPURegs.Init; }
-      }
-      End;
-
-      Procedure TPaiProp.DestroyOp(const o:Toper; var InstrSinceLastMod:
-                  TInstrSinceLastMod);
-      Begin
-      {!!!!!!!
-        Case o.typ Of
-          top_reg: DestroyReg(o.reg, InstrSinceLastMod);
-          top_ref:
-            Begin
-              ReadRef(o.ref);
-              DestroyRefs(o.ref^, R_NO, InstrSinceLastMod);
-            End;
-          top_symbol:;
-        End;
-      }
-      End;
-
-      Procedure TPaiProp.ReadReg(Reg: TRegister);
-      Begin
-      {!!!!!!!
-        Reg := RegMaxSize(Reg);
-        If Reg in General_Registers Then
-          IncRState(RegMaxSize(Reg))
-      }
-      End;
-
-      Procedure TPaiProp.ReadRef(Ref: PReference);
-      Begin
-      {!!!!!!!
-        If Ref^.Base <> R_NO Then
-          ReadReg(Ref^.Base);
-      {$ifdef refsHaveIndexReg}
-        If Ref^.Index <> R_NO Then
-          ReadReg(Ref^.Index);
-      {$endif}
-      }
-      End;
-
-      Procedure TPaiProp.ReadOp(const o:toper);
-      Begin
-        Case o.typ Of
-          top_reg: ReadReg(o.reg);
-          top_ref: ReadRef(o.ref);
-        else
-          internalerror(200410241);
-        End;
-      End;
-
-      Procedure TPaiProp.ModifyReg(reg: TRegister; Var InstrSinceLastMod:
-                                     TInstrSinceLastMod);
-      Begin
-      {!!!!!!!
-        With Regs[reg] Do
-          If (Typ = Con_Ref)
-            Then
-              Begin
-                IncState(WState);
-       {also store how many instructions are part of the sequence in the first
-        instructions PPaiProp, so it can be easily accessed from within
-        CheckSequence}
-                Inc(NrOfMods, InstrSinceLastMod[Reg]);
-                PPaiProp(StartMod.OptInfo)^.Regs[Reg].NrOfMods := NrOfMods;
-                InstrSinceLastMod[Reg] := 0;
-              End
-            Else
-              DestroyReg(Reg, InstrSinceLastMod);
-      }
-      End;
-
-      Procedure TPaiProp.ModifyOp(const oper: TOper; var InstrSinceLastMod:
-                  TInstrSinceLastMod);
-      Begin
-        If oper.typ = top_reg Then
-          ModifyReg(RegMaxSize(oper.reg),InstrSinceLastMod)
-        Else
-          Begin
-            ReadOp(oper);
-            DestroyOp(oper, InstrSinceLastMod);
-          End
-      End;
-
-      Procedure TPaiProp.IncWState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
-      Begin
-        //!!!! IncState(Regs[Reg].WState);
-      End;
-
-      Procedure TPaiProp.IncRState(Reg: TRegister);{$ifdef inl} inline;{$endif inl}
-      Begin
-        //!!!! IncState(Regs[Reg].RState);
-      End;
-
-      Function TPaiProp.GetWState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
-      Begin
-        //!!!! GetWState := Regs[Reg].WState
-      End;
-
-      Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl}
-      Begin
-        //!!!! GetRState := Regs[Reg].RState
-      End;
-
-      Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl}
-      Begin
-        //!!!! GetRegContentType := Regs[Reg].typ
-      End;
-
-      Destructor TPaiProp.Done;
-      Begin
-        //!!!! UsedRegs.Done;
-        //!!!! CondRegs.Done;
-      {  DirFlag: TFlagContents; I386 specific}
-      End;
-      { ************************ private TPaiProp stuff ************************* }
-
-      Procedure TPaiProp.IncState(Var s: TStateInt); {$ifdef inl} inline;{$endif inl}
-      Begin
-        If s <> High(TStateInt) Then Inc(s)
-        Else s := 0
-      End;
-
-      Function TPaiProp.RefInInstruction(Const Ref: TReference; p: Tai;
-        RefsEq: TRefCompare): Boolean;
-      Var Count: AWord;
-          TmpResult: Boolean;
-      Begin
-        TmpResult := False;
-        If (p.typ = ait_instruction) Then
-          Begin
-            Count := 0;
-            Repeat
-              If (TInstr(p).oper[Count]^.typ = Top_Ref) Then
-                TmpResult := RefsEq(Ref, PInstr(p)^.oper[Count]^.ref^);
-              Inc(Count);
-            Until (Count = MaxOps) or TmpResult;
-          End;
-        RefInInstruction := TmpResult;
-      End;
-
-      Function TPaiProp.RefInSequence(Const Ref: TReference; Content: TContent;
-        RefsEq: TRefCompare): Boolean;
-      Var p: Tai;
-          Counter: Byte;
-          TmpResult: Boolean;
-      Begin
-        p := Content.StartMod;
-        TmpResult := False;
-        Counter := 1;
-        While Not(TmpResult) And
-              (Counter <= Content.NrOfMods) Do
-          Begin
-            If (p.typ = ait_instruction) And
-               RefInInstruction(Ref, p, {$ifdef fpc}@{$endif}references_equal)
-              Then TmpResult := True;
-            Inc(Counter);
-            GetNextInstruction(p,p)
-          End;
-        RefInSequence := TmpResult
-      End;
-
-      { ************************************************************************* }
-      { ***************************** TAoptObj ********************************** }
-      { ************************************************************************* }
-
-      Constructor TAoptObj.create(_AsmL: TAasmOutput; _BlockStart, _BlockEnd: Tai;
-                                  _LabelInfo: PLabelInfo);
-      Begin
-        AsmL := _AsmL;
-        BlockStart := _BlockStart;
-        BlockEnd := _BlockEnd;
-        LabelInfo := _LabelInfo
-      End;
-
-      Function TAOptObj.FindLabel(L: TasmLabel; Var hp: Tai): Boolean;
-      Var TempP: Tai;
-      Begin
-        TempP := hp;
-        While Assigned(TempP) and
-             (TempP.typ In SkipInstr + [ait_label]) Do
-          If (TempP.typ <> ait_Label) Or
-             (Tai_label(TempP).l <> L)
-            Then GetNextInstruction(TempP, TempP)
-            Else
-              Begin
-                hp := TempP;
-                FindLabel := True;
-                exit
-              End;
-        FindLabel := False;
-      End;
-
-      Procedure TAOptObj.InsertLLItem(prev, foll, new_one : TLinkedListItem);
-      Begin
-        If Assigned(prev) Then
-          If Assigned(foll) Then
-            Begin
-              If Assigned(new_one) Then
-                Begin
-                  new_one.previous := prev;
-                  new_one.next := foll;
-                  prev.next := new_one;
-                  foll.previous := new_one;
-                  { should we update line information? }
-                  if (not (tai(new_one).typ in SkipLineInfo)) and
-                     (not (tai(foll).typ in SkipLineInfo)) then
-                    Tailineinfo(new_one).fileinfo := Tailineinfo(foll).fileinfo
-                End
-            End
-          Else AsmL.Concat(new_one)
-        Else If Assigned(Foll) Then AsmL.Insert(new_one)
-      End;
-
-
-      Function TAOptObj.SkipHead(P: Tai): Tai;
-      Var OldP: Tai;
-      Begin
-        Repeat
-          OldP := P;
-          If (P.typ in SkipInstr) Or
-             ((P.typ = ait_marker) And
-              (Tai_Marker(P).Kind = AsmBlockEnd)) Then
-            GetNextInstruction(P, P)
-          Else If ((P.Typ = Ait_Marker) And
-              (Tai_Marker(P).Kind = NoPropInfoStart)) Then
-       { a marker of the type NoPropInfoStart can't be the first instruction of a }
-       { paasmoutput list                                                         }
-            GetNextInstruction(Tai(P.Previous),P);
-          If (P.Typ = Ait_Marker) And
-             (Tai_Marker(P).Kind = AsmBlockStart) Then
-            Begin
-              P := Tai(P.Next);
-              While (P.typ <> Ait_Marker) Or
-                    (Tai_Marker(P).Kind <> AsmBlockEnd) Do
-                P := Tai(P.Next)
-            End;
-          Until P = OldP;
-        SkipHead := P;
-      End;
-
-      Function TAOptObj.OpsEqual(const o1,o2:toper): Boolean;
-      Begin
-        if o1.typ=o2.typ then
-          Case o1.typ Of
-            Top_Reg :
-              OpsEqual:=o1.reg=o2.reg;
-            Top_Ref :
-              OpsEqual := references_equal(o1.ref^, o2.ref^);
-            Top_Const :
-              OpsEqual:=o1.val=o2.val;
-            Top_None :
-              OpsEqual := True
-            else OpsEqual := False
-          End;
-      End;
-
-      Function TAOptObj.FindRegAlloc(Reg: TRegister; StartPai: Tai): Boolean;
-      Begin
-        FindRegAlloc:=False;
-        Repeat
-          While Assigned(StartPai) And
-                ((StartPai.typ in (SkipInstr - [ait_regAlloc])) Or
-                 ((StartPai.typ = ait_label) and
-                  Not(Tai_Label(StartPai).l.Is_Used))) Do
-            StartPai := Tai(StartPai.Next);
-          If Assigned(StartPai) And
-             (StartPai.typ = ait_regAlloc) and (tai_regalloc(StartPai).ratype=ra_alloc) Then
-            Begin
-              if tai_regalloc(StartPai).Reg = Reg then
-               begin
-                 FindRegAlloc:=true;
-                 exit;
-               end;
-              StartPai := Tai(StartPai.Next);
-            End
-          else
-            exit;
-        Until false;
-      End;
-
-
-    function SkipLabels(hp: tai; var hp2: tai): boolean;
-      {skips all labels and returns the next "real" instruction}
-      begin
-        while assigned(hp.next) and
-              (tai(hp.next).typ in SkipInstr + [ait_label,ait_align]) Do
-          hp := tai(hp.next);
-        if assigned(hp.next) then
-          begin
-            SkipLabels := True;
-            hp2 := tai(hp.next)
-          end
-        else
-          begin
-            hp2 := hp;
-            SkipLabels := False
-          end;
-      end;
-
-
-    function FindAnyLabel(hp: tai; var l: tasmlabel): Boolean;
-      begin
-        FindAnyLabel := false;
-        while assigned(hp.next) and
-              (tai(hp.next).typ in (SkipInstr+[ait_align])) Do
-          hp := tai(hp.next);
-        if assigned(hp.next) and
-           (tai(hp.next).typ = ait_label) then
-          begin
-            FindAnyLabel := true;
-            l := tai_label(hp.next).l;
-          end
-      end;
-
-
-{$ifopt r+}
-{$define rangewason}
-{$r-}
-{$endif}
-    function tAOptObj.getlabelwithsym(sym: tasmlabel): tai;
-      begin
-        if (sym.labelnr >= labelinfo^.lowlabel) and
-           (sym.labelnr <= labelinfo^.highlabel) then   { range check, a jump can go past an assembler block! }
-          getlabelwithsym := labelinfo^.labeltable^[sym.labelnr-labelinfo^.lowlabel].paiobj
-        else
-          getlabelwithsym := nil;
-      end;
-{$ifdef rangewason}
-{$r+}
-{$undef rangewason}
-{$endif}
-
-    function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean;
-      {traces sucessive jumps to their final destination and sets it, e.g.
-       je l1                je l3
-       <code>               <code>
-       l1:       becomes    l1:
-       je l2                je l3
-       <code>               <code>
-       l2:                  l2:
-       jmp l3               jmp l3
-
-       the level parameter denotes how deeep we have already followed the jump,
-       to avoid endless loops with constructs such as "l5: ; jmp l5"           }
-
-      var p1, p2: tai;
-          l: tasmlabel;
-
-      begin
-        GetfinalDestination := false;
-        if level > 20 then
-          exit;
-        p1 := getlabelwithsym(tasmlabel(hp.oper[0]^.ref^.symbol));
-        if assigned(p1) then
-          begin
-            SkipLabels(p1,p1);
-            if (tai(p1).typ = ait_instruction) and
-               (taicpu(p1).is_jmp) then
-              if { the next instruction after the label where the jump hp arrives}
-                 { is unconditional or of the same type as hp, so continue       }
-                 (((taicpu(p1).opcode = aopt_uncondjmp) and
-                   (taicpu(p1).oper[0]^.typ = top_ref) and
-                   (assigned(taicpu(p1).oper[0]^.ref^.symbol)) and
-                   (taicpu(p1).oper[0]^.ref^.symbol is TAsmLabel)) or
-                  conditions_equal(taicpu(p1).condition,hp.condition)) or
-                 { the next instruction after the label where the jump hp arrives}
-                 { is the opposite of hp (so this one is never taken), but after }
-                 { that one there is a branch that will be taken, so perform a   }
-                 { little hack: set p1 equal to this instruction (that's what the}
-                 { last SkipLabels is for, only works with short bool evaluation)}
-                 (conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) and
-                  SkipLabels(p1,p2) and
-                  (p2.typ = ait_instruction) and
-                  (taicpu(p2).is_jmp) and
-                  (((taicpu(p2).opcode = aopt_uncondjmp) and
-                    (taicpu(p2).oper[0]^.typ = top_ref) and
-                    (assigned(taicpu(p2).oper[0]^.ref^.symbol)) and
-                    (taicpu(p2).oper[0]^.ref^.symbol is TAsmLabel)) or
-                   (conditions_equal(taicpu(p2).condition,hp.condition))) and
-                  SkipLabels(p1,p1)) then
-                begin
-                  { quick check for loops of the form "l5: ; jmp l5 }
-                  if (tasmlabel(taicpu(p1).oper[0]^.ref^.symbol).labelnr =
-                       tasmlabel(hp.oper[0]^.ref^.symbol).labelnr) then
-                    exit;
-                  if not GetFinalDestination(taicpu(p1),succ(level)) then
-                    exit;
-                  tasmlabel(hp.oper[0]^.ref^.symbol).decrefs;
-                  hp.oper[0]^.ref^.symbol:=taicpu(p1).oper[0]^.ref^.symbol;
-                  tasmlabel(hp.oper[0]^.ref^.symbol).increfs;
-                end
-              else
-                if conditions_equal(taicpu(p1).condition,inverse_cond(hp.condition)) then
-                  if not FindAnyLabel(p1,l) then
-                    begin
-      {$ifdef finaldestdebug}
-                      insertllitem(asml,p1,p1.next,tai_comment.Create(
-                        strpnew('previous label inserted'))));
-      {$endif finaldestdebug}
-                      objectlibrary.getjumplabel(l);
-                      insertllitem(p1,p1.next,tai_label.Create(l));
-                      tasmlabel(taicpu(hp).oper[0]^.ref^.symbol).decrefs;
-                      hp.oper[0]^.ref^.symbol := l;
-                      l.increfs;
-      {               this won't work, since the new label isn't in the labeltable }
-      {               so it will fail the rangecheck. Labeltable should become a   }
-      {               hashtable to support this:                                   }
-      {               GetFinalDestination(asml, hp);                               }
-                    end
-                  else
-                    begin
-      {$ifdef finaldestdebug}
-                      insertllitem(asml,p1,p1.next,tai_comment.Create(
-                        strpnew('next label reused'))));
-      {$endif finaldestdebug}
-                      l.increfs;
-                      hp.oper[0]^.ref^.symbol := l;
-                      if not GetFinalDestination(hp,succ(level)) then
-                        exit;
-                    end;
-          end;
-        GetFinalDestination := true;
-      end;
-
-
-    procedure TAOptObj.PrePeepHoleOpts;
-      begin
-      end;
-
-
-    procedure TAOptObj.PeepHoleOptPass1;
-      var
-        p,hp1,hp2 : tai;
-      begin
-        p := BlockStart;
-        //!!!! UsedRegs := [];
-        while (p <> BlockEnd) Do
-          begin
-            //!!!! UpDateUsedRegs(UsedRegs, tai(p.next));
-            if PeepHoleOptPass1Cpu(p) then
-              continue;
-            case p.Typ Of
-              ait_instruction:
-                begin
-                  { Handle Jmp Optimizations }
-                  if taicpu(p).is_jmp then
-                    begin
-                      { the following if-block removes all code between a jmp and the next label,
-                        because it can never be executed
-                      }
-                      if (taicpu(p).opcode = aopt_uncondjmp) and
-                         (taicpu(p).oper[0]^.typ = top_ref) and
-                         (assigned(taicpu(p).oper[0]^.ref^.symbol)) and
-                         (taicpu(p).oper[0]^.ref^.symbol is TAsmLabel) then
-                        begin
-                          while GetNextInstruction(p, hp1) and
-                                (hp1.typ <> ait_label) do
-                            if not(hp1.typ in ([ait_label,ait_align]+skipinstr)) then
-                              begin
-                                asml.remove(hp1);
-                                hp1.free;
-                              end
-                            else break;
-                          end;
-                      { remove jumps to a label coming right after them }
-                      if GetNextInstruction(p, hp1) then
-                        begin
-                          if FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol), hp1) and
-        {$warning FIXME removing the first instruction fails}
-                              (p<>blockstart) then
-                            begin
-                              hp2:=tai(hp1.next);
-                              asml.remove(p);
-                              p.free;
-                              p:=hp2;
-                              continue;
-                            end
-                          else
-                            begin
-                              if hp1.typ = ait_label then
-                                SkipLabels(hp1,hp1);
-                              if (tai(hp1).typ=ait_instruction) and
-                                  (taicpu(hp1).opcode=aopt_uncondjmp) and
-                                  (taicpu(hp1).oper[0]^.typ = top_ref) and
-                                  (assigned(taicpu(hp1).oper[0]^.ref^.symbol)) and
-                                  (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) and
-                                  GetNextInstruction(hp1, hp2) and
-                                  FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol), hp2) then
-                                begin
-                                  if taicpu(p).opcode=aopt_condjmp then
-                                    begin
-                                      taicpu(p).condition:=inverse_cond(taicpu(p).condition);
-                                      tai_label(hp2).l.decrefs;
-                                      taicpu(p).oper[0]^.ref^.symbol:=taicpu(hp1).oper[0]^.ref^.symbol;
-                                      taicpu(p).oper[0]^.ref^.symbol.increfs;
-{$ifdef SPARC}
-                                      hp2:=tai(hp1.next);
-                                      asml.remove(hp2);
-                                      hp2.free;
-{$endif SPARC}
-                                      asml.remove(hp1);
-                                      hp1.free;
-                                      GetFinalDestination(taicpu(p),0);
-                                    end
-                                  else
-                                    begin
-                                      GetFinalDestination(taicpu(p),0);
-                                      p:=tai(p.next);
-                                      continue;
-                                    end;
-                                end
-                              else
-                                GetFinalDestination(taicpu(p),0);
-                            end;
-                        end;
-                    end
-                  else
-                  { All other optimizes }
-                    begin
-                    end; { if is_jmp }
-                end;
-            end;
-            //!!!!!!!! updateUsedRegs(UsedRegs,p);
-            p:=tai(p.next);
-          end;
-      end;
-
-
-    procedure TAOptObj.PeepHoleOptPass2;
-      begin
-      end;
-
-
-    procedure TAOptObj.PostPeepHoleOpts;
-      var
-        p: tai;
-      begin
-        p := BlockStart;
-        //!!!! UsedRegs := [];
-        while (p <> BlockEnd) Do
-          begin
-            //!!!! UpDateUsedRegs(UsedRegs, tai(p.next));
-            if PostPeepHoleOptsCpu(p) then
-              continue;
-            //!!!!!!!! updateUsedRegs(UsedRegs,p);
-            p:=tai(p.next);
-          end;
-      end;
-
-
-    function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean;
-      begin
-        result := false;
-      end;
-
-
-    function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean;
-      begin
-        result := false;
-      end;
-
-End.

compiler/compiler/arm/aasmcpu.pas

@@ -1,2399 +0,0 @@
-{
-    Copyright (c) 2003 by Florian Klaempfl
-
-    Contains the assembler object for the ARM
-
-    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
-  cclasses,globtype,globals,verbose,
-  aasmbase,aasmtai,
-  symtype,
-  cpubase,cpuinfo,cgbase,cgutils;
-
-    const
-      { "mov reg,reg" source operand number }
-      O_MOV_SOURCE = 1;
-      { "mov reg,reg" source operand number }
-      O_MOV_DEST = 0;
-
-      { Operand types }
-      OT_NONE      = $00000000;
-
-      OT_BITS8     = $00000001;  { size, and other attributes, of the operand  }
-      OT_BITS16    = $00000002;
-      OT_BITS32    = $00000004;
-      OT_BITS64    = $00000008;  { FPU only  }
-      OT_BITS80    = $00000010;
-      OT_FAR       = $00000020;  { this means 16:16 or 16:32, like in CALL/JMP }
-      OT_NEAR      = $00000040;
-      OT_SHORT     = $00000080;
-      OT_BITSTINY  = $00000100;  { fpu constant }
-      OT_BITSSHIFTER =
-                     $00000200;
-
-      OT_SIZE_MASK = $000003FF;  { all the size attributes  }
-      OT_NON_SIZE  = longint(not OT_SIZE_MASK);
-
-      OT_SIGNED    = $00000100;  { the operand need to be signed -128-127 }
-
-      OT_TO        = $00000200;  { operand is followed by a colon  }
-                                 { reverse effect in FADD, FSUB &c  }
-      OT_COLON     = $00000400;
-
-      OT_SHIFTEROP = $00000800;
-      OT_REGISTER  = $00001000;
-      OT_IMMEDIATE = $00002000;
-      OT_REGLIST   = $00008000;
-      OT_IMM8      = $00002001;
-      OT_IMM24     = $00002002;
-      OT_IMM32     = $00002004;
-      OT_IMM64     = $00002008;
-      OT_IMM80     = $00002010;
-      OT_IMMTINY   = $00002100;
-      OT_IMMSHIFTER= $00002200;
-      OT_IMMEDIATE24 = OT_IMM24;
-      OT_SHIFTIMM  = OT_SHIFTEROP or OT_IMMSHIFTER;
-      OT_SHIFTIMMEDIATE = OT_SHIFTIMM;
-      OT_IMMEDIATESHIFTER = OT_IMMSHIFTER;
-
-      OT_IMMEDIATEFPU = OT_IMMTINY;
-
-      OT_REGMEM    = $00200000;  { for r/m, ie EA, operands  }
-      OT_REGNORM   = $00201000;  { 'normal' reg, qualifies as EA  }
-      OT_REG8      = $00201001;
-      OT_REG16     = $00201002;
-      OT_REG32     = $00201004;
-      OT_REG64     = $00201008;
-      OT_VREG      = $00201010;  { vector register }
-      OT_MEMORY    = $00204000;  { register number in 'basereg'  }
-      OT_MEM8      = $00204001;
-      OT_MEM16     = $00204002;
-      OT_MEM32     = $00204004;
-      OT_MEM64     = $00204008;
-      OT_MEM80     = $00204010;
-      { word/byte load/store }
-      OT_AM2       = $00010000;
-      { misc ld/st operations }
-      OT_AM3       = $00020000;
-      { multiple ld/st operations }
-      OT_AM4       = $00040000;
-      { co proc. ld/st operations }
-      OT_AM5       = $00080000;
-      OT_AMMASK    = $000f0000;
-
-      OT_MEMORYAM2 = OT_MEMORY or OT_AM2;
-      OT_MEMORYAM3 = OT_MEMORY or OT_AM3;
-      OT_MEMORYAM4 = OT_MEMORY or OT_AM4;
-      OT_MEMORYAM5 = OT_MEMORY or OT_AM5;
-
-      OT_FPUREG    = $01000000;  { floating point stack registers  }
-      OT_REG_SMASK = $00070000;  { special register operands: these may be treated differently  }
-                                 { a mask for the following  }
-
-      OT_MEM_OFFS  = $00604000;  { special type of EA  }
-                                 { simple [address] offset  }
-      OT_ONENESS   = $00800000;  { special type of immediate operand  }
-                                 { so UNITY == IMMEDIATE | ONENESS  }
-      OT_UNITY     = $00802000;  { for shift/rotate instructions  }
-
-      instabentries = {$i armnop.inc}
-
-      maxinfolen = 5;
-
-      IF_NONE   = $00000000;
-
-      IF_ARMMASK    = $000F0000;
-      IF_ARM7       = $00070000;
-      IF_FPMASK     = $00F00000;
-      IF_FPA        = $00100000;
-
-      { if the instruction can change in a second pass }
-      IF_PASS2  = longint($80000000);
-
-    type
-      TInsTabCache=array[TasmOp] of longint;
-      PInsTabCache=^TInsTabCache;
-
-      tinsentry = record
-        opcode  : tasmop;
-        ops     : byte;
-        optypes : array[0..3] of longint;
-        code    : array[0..maxinfolen] of char;
-        flags   : longint;
-      end;
-
-      pinsentry=^tinsentry;
-
-    const
-      InsTab : array[0..instabentries-1] of TInsEntry={$i armtab.inc}
-
-    var
-      InsTabCache : PInsTabCache;
-
-    type
-      taicpu = class(tai_cpu_abstract)
-         oppostfix : TOpPostfix;
-         roundingmode : troundingmode;
-         procedure loadshifterop(opidx:longint;const so:tshifterop);
-         procedure loadregset(opidx:longint;const s:tcpuregisterset);
-         constructor op_none(op : tasmop);
-
-         constructor op_reg(op : tasmop;_op1 : tregister);
-         constructor op_const(op : tasmop;_op1 : longint);
-
-         constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
-         constructor op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference);
-         constructor op_reg_const(op:tasmop; _op1: tregister; _op2: aint);
-
-         constructor op_ref_regset(op:tasmop; _op1: treference; _op2: tcpuregisterset);
-
-         constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
-         constructor op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: aint);
-         constructor op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint);
-         constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; const _op3: treference);
-         constructor op_reg_reg_shifterop(op : tasmop;_op1,_op2 : tregister;_op3 : tshifterop);
-         { SFM/LFM }
-         constructor op_reg_const_ref(op : tasmop;_op1 : tregister;_op2 : aint;_op3 : treference);
-
-         { *M*LL }
-         constructor op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
-
-         { 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_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint);
-         constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
-
-         function is_same_reg_move(regtype: Tregistertype):boolean; override;
-
-         function spilling_get_operation_type(opnr: longint): topertype;override;
-
-         { assembler }
-      public
-         { the next will reset all instructions that can change in pass 2 }
-         procedure ResetPass1;
-         procedure ResetPass2;
-         function  CheckIfValid:boolean;
-         function GetString:string;
-         function Pass1(offset:longint):longint;override;
-         procedure Pass2(objdata:TAsmObjectdata);override;
-      protected
-         procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);override;
-         procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);override;
-         procedure ppubuildderefimploper(var o:toper);override;
-         procedure ppuderefoper(var o:toper);override;
-      private
-         { next fields are filled in pass1, so pass2 is faster }
-         inssize   : shortint;
-         insoffset : longint;
-         LastInsOffset : longint; { need to be public to be reset }
-         insentry  : PInsEntry;
-         function  InsEnd:longint;
-         procedure create_ot;
-         function  Matches(p:PInsEntry):longint;
-         function  calcsize(p:PInsEntry):shortint;
-         procedure gencode(objdata:TAsmObjectData);
-         function  NeedAddrPrefix(opidx:byte):boolean;
-         procedure Swapoperands;
-         function  FindInsentry:boolean;
-      end;
-
-      tai_align = class(tai_align_abstract)
-        { nothing to add }
-      end;
-
-    function spilling_create_load(const ref:treference;r:tregister): tai;
-    function spilling_create_store(r:tregister; const ref:treference): tai;
-
-    function setoppostfix(i : taicpu;pf : toppostfix) : taicpu;
-    function setroundingmode(i : taicpu;rm : troundingmode) : taicpu;
-    function setcondition(i : taicpu;c : tasmcond) : taicpu;
-
-    { inserts pc relative symbols at places where they are reachable }
-    procedure insertpcrelativedata(list,listtoinsert : taasmoutput);
-
-    procedure InitAsm;
-    procedure DoneAsm;
-
-
-implementation
-
-  uses
-    cutils,rgobj,itcpugas;
-
-
-    procedure taicpu.loadshifterop(opidx:longint;const so:tshifterop);
-      begin
-        allocate_oper(opidx+1);
-        with oper[opidx]^ do
-          begin
-            if typ<>top_shifterop then
-              begin
-                clearop(opidx);
-                new(shifterop);
-              end;
-            shifterop^:=so;
-            typ:=top_shifterop;
-            if assigned(add_reg_instruction_hook) then
-              add_reg_instruction_hook(self,shifterop^.rs);
-          end;
-      end;
-
-
-    procedure taicpu.loadregset(opidx:longint;const s:tcpuregisterset);
-      var
-        i : byte;
-      begin
-        allocate_oper(opidx+1);
-        with oper[opidx]^ do
-         begin
-           if typ<>top_regset then
-             clearop(opidx);
-           new(regset);
-           regset^:=s;
-           typ:=top_regset;
-           for i:=RS_R0 to RS_R15 do
-             begin
-               if assigned(add_reg_instruction_hook) and (i in regset^) then
-                 add_reg_instruction_hook(self,newreg(R_INTREGISTER,i,R_SUBWHOLE));
-             end;
-         end;
-      end;
-
-
-{*****************************************************************************
-                                 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;
-         loadreg(0,_op1);
-      end;
-
-
-    constructor taicpu.op_const(op : tasmop;_op1 : longint);
-      begin
-         inherited create(op);
-         ops:=1;
-         loadconst(0,aint(_op1));
-      end;
-
-
-    constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-      end;
-
-
-    constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: aint);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadreg(0,_op1);
-         loadconst(1,aint(_op2));
-      end;
-
-
-    constructor taicpu.op_ref_regset(op:tasmop; _op1: treference; _op2: tcpuregisterset);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadref(0,_op1);
-         loadregset(1,_op2);
-      end;
-
-
-    constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;const _op2 : treference);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadreg(0,_op1);
-         loadref(1,_op2);
-      end;
-
-
-    constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
-      begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadreg(2,_op3);
-      end;
-
-
-    constructor taicpu.op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister);
-      begin
-         inherited create(op);
-         ops:=4;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadreg(2,_op3);
-         loadreg(3,_op4);
-      end;
-
-
-     constructor taicpu.op_reg_reg_const(op : tasmop;_op1,_op2 : tregister; _op3: aint);
-       begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadconst(2,aint(_op3));
-      end;
-
-
-    constructor taicpu.op_reg_const_ref(op : tasmop;_op1 : tregister;_op2 : aint;_op3 : treference);
-      begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadconst(1,_op2);
-         loadref(2,_op3);
-      end;
-
-
-     constructor taicpu.op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: longint);
-       begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadsymbol(0,_op3,_op3ofs);
-      end;
-
-
-     constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; const _op3: treference);
-       begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadref(2,_op3);
-      end;
-
-
-     constructor taicpu.op_reg_reg_shifterop(op : tasmop;_op1,_op2 : tregister;_op3 : tshifterop);
-      begin
-         inherited create(op);
-         ops:=3;
-         loadreg(0,_op1);
-         loadreg(1,_op2);
-         loadshifterop(2,_op3);
-      end;
-
-
-    constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
-      begin
-         inherited create(op);
-         condition:=cond;
-         ops:=1;
-         loadsymbol(0,_op1,0);
-      end;
-
-
-    constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
-      begin
-         inherited create(op);
-         ops:=1;
-         loadsymbol(0,_op1,0);
-      end;
-
-
-    constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
-      begin
-         inherited create(op);
-         ops:=1;
-         loadsymbol(0,_op1,_op1ofs);
-      end;
-
-
-     constructor taicpu.op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : longint);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadreg(0,_op1);
-         loadsymbol(1,_op2,_op2ofs);
-      end;
-
-
-    constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference);
-      begin
-         inherited create(op);
-         ops:=2;
-         loadsymbol(0,_op1,_op1ofs);
-         loadref(1,_op2);
-      end;
-
-
-    function taicpu.is_same_reg_move(regtype: Tregistertype):boolean;
-      begin
-        { allow the register allocator to remove unnecessary moves }
-        result:=(((opcode=A_MOV) and (regtype = R_INTREGISTER)) or
-                 ((opcode=A_MVF) and (regtype = R_FPUREGISTER))
-                ) and
-                (condition=C_None) and
-                (ops=2) and
-                (oper[0]^.typ=top_reg) and
-                (oper[1]^.typ=top_reg) and
-                (oper[0]^.reg=oper[1]^.reg);
-      end;
-
-
-    function spilling_create_load(const ref:treference;r:tregister): tai;
-      begin
-        case getregtype(r) of
-          R_INTREGISTER :
-            result:=taicpu.op_reg_ref(A_LDR,r,ref);
-          R_FPUREGISTER :
-            { use lfm because we don't know the current internal format
-              and avoid exceptions
-            }
-            result:=taicpu.op_reg_const_ref(A_LFM,r,1,ref);
-          else
-            internalerror(200401041);
-        end;
-      end;
-
-
-    function spilling_create_store(r:tregister; const ref:treference): tai;
-      begin
-        case getregtype(r) of
-          R_INTREGISTER :
-            result:=taicpu.op_reg_ref(A_STR,r,ref);
-          R_FPUREGISTER :
-            { use sfm because we don't know the current internal format
-              and avoid exceptions
-            }
-            result:=taicpu.op_reg_const_ref(A_SFM,r,1,ref);
-          else
-            internalerror(200401041);
-        end;
-      end;
-
-
-    function taicpu.spilling_get_operation_type(opnr: longint): topertype;
-      begin
-        case opcode of
-          A_ADC,A_ADD,A_AND,
-          A_EOR,A_CLZ,
-          A_LDR,A_LDRB,A_LDRBT,A_LDRH,A_LDRSB,
-          A_LDRSH,A_LDRT,
-          A_MOV,A_MVN,A_MLA,A_MUL,
-          A_ORR,A_RSB,A_RSC,A_SBC,A_SUB,
-          A_SWP,A_SWPB,
-          A_LDF,A_FLT,A_FIX,
-          A_ADF,A_DVF,A_FDV,A_FML,
-          A_RFS,A_RFC,A_RDF,
-          A_RMF,A_RPW,A_RSF,A_SUF,A_ABS,A_ACS,A_ASN,A_ATN,A_COS,
-          A_EXP,A_LOG,A_LGN,A_MVF,A_MNF,A_FRD,A_MUF,A_POL,A_RND,A_SIN,A_SQT,A_TAN,
-          A_LFM:
-            if opnr=0 then
-              result:=operand_write
-            else
-              result:=operand_read;
-          A_BIC,A_BKPT,A_B,A_BL,A_BLX,A_BX,
-          A_CMN,A_CMP,A_TEQ,A_TST,
-          A_CMF,A_CMFE,A_WFS,A_CNF:
-            result:=operand_read;
-          A_SMLAL,A_UMLAL:
-            if opnr in [0,1] then
-              result:=operand_readwrite
-            else
-              result:=operand_read;
-           A_SMULL,A_UMULL:
-            if opnr in [0,1] then
-              result:=operand_write
-            else
-              result:=operand_read;
-          A_STR,A_STRB,A_STRBT,
-          A_STRH,A_STRT,A_STF,A_SFM:
-            { important is what happens with the involved registers }
-            if opnr=0 then
-              result := operand_read
-            else
-              { check for pre/post indexed }
-              result := operand_read;
-          else
-            internalerror(200403151);
-        end;
-      end;
-
-
-    procedure BuildInsTabCache;
-      var
-        i : longint;
-      begin
-        new(instabcache);
-        FillChar(instabcache^,sizeof(tinstabcache),$ff);
-        i:=0;
-        while (i<InsTabEntries) do
-          begin
-            if InsTabCache^[InsTab[i].Opcode]=-1 then
-              InsTabCache^[InsTab[i].Opcode]:=i;
-            inc(i);
-          end;
-      end;
-
-
-    procedure InitAsm;
-      begin
-        if not assigned(instabcache) then
-          BuildInsTabCache;
-      end;
-
-
-    procedure DoneAsm;
-      begin
-        if assigned(instabcache) then
-          begin
-            dispose(instabcache);
-            instabcache:=nil;
-          end;
-      end;
-
-
-    function setoppostfix(i : taicpu;pf : toppostfix) : taicpu;
-      begin
-        i.oppostfix:=pf;
-        result:=i;
-      end;
-
-
-    function setroundingmode(i : taicpu;rm : troundingmode) : taicpu;
-      begin
-        i.roundingmode:=rm;
-        result:=i;
-      end;
-
-
-    function setcondition(i : taicpu;c : tasmcond) : taicpu;
-      begin
-        i.condition:=c;
-        result:=i;
-      end;
-
-
-    procedure insertpcrelativedata(list,listtoinsert : taasmoutput);
-      var
-        curpos : longint;
-        lastpos : longint;
-        curop : longint;
-        curtai : tai;
-        curdatatai,hp : tai;
-        curdata : taasmoutput;
-        l : tasmlabel;
-      begin
-        curdata:=taasmoutput.create;
-        lastpos:=-1;
-        curpos:=0;
-        curtai:=tai(list.first);
-        while assigned(curtai) do
-          begin
-            { instruction? }
-            if curtai.typ=ait_instruction then
-              begin
-                { walk through all operand of the instruction }
-                for curop:=0 to taicpu(curtai).ops-1 do
-                  begin
-                    { reference? }
-                    if (taicpu(curtai).oper[curop]^.typ=top_ref) then
-                      begin
-                        { pc relative symbol? }
-                        curdatatai:=tai(taicpu(curtai).oper[curop]^.ref^.symboldata);
-                        if assigned(curdatatai) then
-                          begin
-                            { if yes, insert till next symbol }
-                            repeat
-                              hp:=tai(curdatatai.next);
-                              listtoinsert.remove(curdatatai);
-                              curdata.concat(curdatatai);
-                              curdatatai:=hp;
-                            until (curdatatai=nil) or (curdatatai.typ=ait_label);
-                            if lastpos=-1 then
-                              lastpos:=curpos;
-                          end;
-                      end;
-                  end;
-                inc(curpos);
-              end;
-
-            { split only at real instructions else the test below fails }
-            if ((curpos-lastpos)>1016) and (curtai.typ=ait_instruction) and
-              (
-                { don't split loads of pc to lr and the following move }
-                not(
-                    (taicpu(curtai).opcode=A_MOV) and
-                    (taicpu(curtai).oper[0]^.typ=top_reg) and
-                    (taicpu(curtai).oper[0]^.reg=NR_R14) and
-                    (taicpu(curtai).oper[1]^.typ=top_reg) and
-                    (taicpu(curtai).oper[1]^.reg=NR_PC)
-                   )
-              ) then
-              begin
-                lastpos:=curpos;
-                hp:=tai(curtai.next);
-                objectlibrary.getjumplabel(l);
-                curdata.insert(taicpu.op_sym(A_B,l));
-                curdata.concat(tai_label.create(l));
-                list.insertlistafter(curtai,curdata);
-                curtai:=hp;
-              end
-            else
-              curtai:=tai(curtai.next);
-          end;
-        list.concatlist(curdata);
-        curdata.free;
-      end;
-
-
-(*
-      Floating point instruction format information, taken from the linux kernel
-      ARM Floating Point Instruction Classes
-      | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
-      |c o n d|1 1 0 P|U|u|W|L|   Rn  |v|  Fd |0|0|0|1|  o f f s e t  | CPDT
-      |c o n d|1 1 0 P|U|w|W|L|   Rn  |x|  Fd |0|0|1|0|  o f f s e t  | CPDT (copro 2)
-      | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
-      |c o n d|1 1 1 0|a|b|c|d|e|  Fn |j|  Fd |0|0|0|1|f|g|h|0|i|  Fm | CPDO
-      |c o n d|1 1 1 0|a|b|c|L|e|  Fn |   Rd  |0|0|0|1|f|g|h|1|i|  Fm | CPRT
-      |c o n d|1 1 1 0|a|b|c|1|e|  Fn |1|1|1|1|0|0|0|1|f|g|h|1|i|  Fm | comparisons
-      | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
-
-      CPDT            data transfer instructions
-                      LDF, STF, LFM (copro 2), SFM (copro 2)
-
-      CPDO            dyadic arithmetic instructions
-                      ADF, MUF, SUF, RSF, DVF, RDF,
-                      POW, RPW, RMF, FML, FDV, FRD, POL
-
-      CPDO            monadic arithmetic instructions
-                      MVF, MNF, ABS, RND, SQT, LOG, LGN, EXP,
-                      SIN, COS, TAN, ASN, ACS, ATN, URD, NRM
-
-      CPRT            joint arithmetic/data transfer instructions
-                      FIX (arithmetic followed by load/store)
-                      FLT (load/store followed by arithmetic)
-                      CMF, CNF CMFE, CNFE (comparisons)
-                      WFS, RFS (write/read floating point status register)
-                      WFC, RFC (write/read floating point control register)
-
-      cond            condition codes
-      P               pre/post index bit: 0 = postindex, 1 = preindex
-      U               up/down bit: 0 = stack grows down, 1 = stack grows up
-      W               write back bit: 1 = update base register (Rn)
-      L               load/store bit: 0 = store, 1 = load
-      Rn              base register
-      Rd              destination/source register
-      Fd              floating point destination register
-      Fn              floating point source register
-      Fm              floating point source register or floating point constant
-
-      uv              transfer length (TABLE 1)
-      wx              register count (TABLE 2)
-      abcd            arithmetic opcode (TABLES 3 & 4)
-      ef              destination size (rounding precision) (TABLE 5)
-      gh              rounding mode (TABLE 6)
-      j               dyadic/monadic bit: 0 = dyadic, 1 = monadic
-      i               constant bit: 1 = constant (TABLE 6)
-      */
-
-      /*
-      TABLE 1
-      +-------------------------+---+---+---------+---------+
-      |  Precision              | u | v | FPSR.EP | length  |
-      +-------------------------+---+---+---------+---------+
-      | Single                  | 0 | 0 |    x    | 1 words |
-      | Double                  | 1 | 1 |    x    | 2 words |
-      | Extended                | 1 | 1 |    x    | 3 words |
-      | Packed decimal          | 1 | 1 |    0    | 3 words |
-      | Expanded packed decimal | 1 | 1 |    1    | 4 words |
-      +-------------------------+---+---+---------+---------+
-      Note: x = don't care
-      */
-
-      /*
-      TABLE 2
-      +---+---+---------------------------------+
-      | w | x | Number of registers to transfer |
-      +---+---+---------------------------------+
-      | 0 | 1 |  1                              |
-      | 1 | 0 |  2                              |
-      | 1 | 1 |  3                              |
-      | 0 | 0 |  4                              |
-      +---+---+---------------------------------+
-      */
-
-      /*
-      TABLE 3: Dyadic Floating Point Opcodes
-      +---+---+---+---+----------+-----------------------+-----------------------+
-      | a | b | c | d | Mnemonic | Description           | Operation             |
-      +---+---+---+---+----------+-----------------------+-----------------------+
-      | 0 | 0 | 0 | 0 | ADF      | Add                   | Fd := Fn + Fm         |
-      | 0 | 0 | 0 | 1 | MUF      | Multiply              | Fd := Fn * Fm         |
-      | 0 | 0 | 1 | 0 | SUF      | Subtract              | Fd := Fn - Fm         |
-      | 0 | 0 | 1 | 1 | RSF      | Reverse subtract      | Fd := Fm - Fn         |
-      | 0 | 1 | 0 | 0 | DVF      | Divide                | Fd := Fn / Fm         |
-      | 0 | 1 | 0 | 1 | RDF      | Reverse divide        | Fd := Fm / Fn         |
-      | 0 | 1 | 1 | 0 | POW      | Power                 | Fd := Fn ^ Fm         |
-      | 0 | 1 | 1 | 1 | RPW      | Reverse power         | Fd := Fm ^ Fn         |
-      | 1 | 0 | 0 | 0 | RMF      | Remainder             | Fd := IEEE rem(Fn/Fm) |
-      | 1 | 0 | 0 | 1 | FML      | Fast Multiply         | Fd := Fn * Fm         |
-      | 1 | 0 | 1 | 0 | FDV      | Fast Divide           | Fd := Fn / Fm         |
-      | 1 | 0 | 1 | 1 | FRD      | Fast reverse divide   | Fd := Fm / Fn         |
-      | 1 | 1 | 0 | 0 | POL      | Polar angle (ArcTan2) | Fd := arctan2(Fn,Fm)  |
-      | 1 | 1 | 0 | 1 |          | undefined instruction | trap                  |
-      | 1 | 1 | 1 | 0 |          | undefined instruction | trap                  |
-      | 1 | 1 | 1 | 1 |          | undefined instruction | trap                  |
-      +---+---+---+---+----------+-----------------------+-----------------------+
-      Note: POW, RPW, POL are deprecated, and are available for backwards
-            compatibility only.
-      */
-
-      /*
-      TABLE 4: Monadic Floating Point Opcodes
-      +---+---+---+---+----------+-----------------------+-----------------------+
-      | a | b | c | d | Mnemonic | Description           | Operation             |
-      +---+---+---+---+----------+-----------------------+-----------------------+
-      | 0 | 0 | 0 | 0 | MVF      | Move                  | Fd := Fm              |
-      | 0 | 0 | 0 | 1 | MNF      | Move negated          | Fd := - Fm            |
-      | 0 | 0 | 1 | 0 | ABS      | Absolute value        | Fd := abs(Fm)         |
-      | 0 | 0 | 1 | 1 | RND      | Round to integer      | Fd := int(Fm)         |
-      | 0 | 1 | 0 | 0 | SQT      | Square root           | Fd := sqrt(Fm)        |
-      | 0 | 1 | 0 | 1 | LOG      | Log base 10           | Fd := log10(Fm)       |
-      | 0 | 1 | 1 | 0 | LGN      | Log base e            | Fd := ln(Fm)          |
-      | 0 | 1 | 1 | 1 | EXP      | Exponent              | Fd := e ^ Fm          |
-      | 1 | 0 | 0 | 0 | SIN      | Sine                  | Fd := sin(Fm)         |
-      | 1 | 0 | 0 | 1 | COS      | Cosine                | Fd := cos(Fm)         |
-      | 1 | 0 | 1 | 0 | TAN      | Tangent               | Fd := tan(Fm)         |
-      | 1 | 0 | 1 | 1 | ASN      | Arc Sine              | Fd := arcsin(Fm)      |
-      | 1 | 1 | 0 | 0 | ACS      | Arc Cosine            | Fd := arccos(Fm)      |
-      | 1 | 1 | 0 | 1 | ATN      | Arc Tangent           | Fd := arctan(Fm)      |
-      | 1 | 1 | 1 | 0 | URD      | Unnormalized round    | Fd := int(Fm)         |
-      | 1 | 1 | 1 | 1 | NRM      | Normalize             | Fd := norm(Fm)        |
-      +---+---+---+---+----------+-----------------------+-----------------------+
-      Note: LOG, LGN, EXP, SIN, COS, TAN, ASN, ACS, ATN are deprecated, and are
-            available for backwards compatibility only.
-      */
-
-      /*
-      TABLE 5
-      +-------------------------+---+---+
-      |  Rounding Precision     | e | f |
-      +-------------------------+---+---+
-      | IEEE Single precision   | 0 | 0 |
-      | IEEE Double precision   | 0 | 1 |
-      | IEEE Extended precision | 1 | 0 |
-      | undefined (trap)        | 1 | 1 |
-      +-------------------------+---+---+
-      */
-
-      /*
-      TABLE 5
-      +---------------------------------+---+---+
-      |  Rounding Mode                  | g | h |
-      +---------------------------------+---+---+
-      | Round to nearest (default)      | 0 | 0 |
-      | Round toward plus infinity      | 0 | 1 |
-      | Round toward negative infinity  | 1 | 0 |
-      | Round toward zero               | 1 | 1 |
-      +---------------------------------+---+---+
-*)
-    function taicpu.GetString:string;
-      var
-        i : longint;
-        s : string;
-        addsize : boolean;
-      begin
-        s:='['+gas_op2str[opcode];
-        for i:=0 to ops-1 do
-         begin
-           with oper[i]^ do
-             begin
-               if i=0 then
-                s:=s+' '
-               else
-                s:=s+',';
-               { type }
-               addsize:=false;
-               if (ot and OT_VREG)=OT_VREG then
-                s:=s+'vreg'
-               else
-                 if (ot and OT_FPUREG)=OT_FPUREG then
-                  s:=s+'fpureg'
-               else
-                if (ot and OT_REGISTER)=OT_REGISTER then
-                 begin
-                   s:=s+'reg';
-                   addsize:=true;
-                 end
-               else
-                if (ot and OT_REGLIST)=OT_REGLIST then
-                 begin
-                   s:=s+'reglist';
-                   addsize:=false;
-                 end
-               else
-                if (ot and OT_IMMEDIATE)=OT_IMMEDIATE then
-                 begin
-                   s:=s+'imm';
-                   addsize:=true;
-                 end
-               else
-                if (ot and OT_MEMORY)=OT_MEMORY then
-                 begin
-                   s:=s+'mem';
-                   addsize:=true;
-                   if (ot and OT_AM2)<>0 then
-                     s:=s+' am2 ';
-                 end
-               else
-                 s:=s+'???';
-               { size }
-               if addsize then
-                begin
-                  if (ot and OT_BITS8)<>0 then
-                    s:=s+'8'
-                  else
-                   if (ot and OT_BITS16)<>0 then
-                    s:=s+'24'
-                  else
-                   if (ot and OT_BITS32)<>0 then
-                    s:=s+'32'
-                  else
-                   if (ot and OT_BITSSHIFTER)<>0 then
-                    s:=s+'shifter'
-                  else
-                    s:=s+'??';
-                  { signed }
-                  if (ot and OT_SIGNED)<>0 then
-                   s:=s+'s';
-                end;
-             end;
-         end;
-        GetString:=s+']';
-      end;
-
-
-    procedure taicpu.ResetPass1;
-      begin
-        { we need to reset everything here, because the choosen insentry
-          can be invalid for a new situation where the previously optimized
-          insentry is not correct }
-        InsEntry:=nil;
-        InsSize:=0;
-        LastInsOffset:=-1;
-      end;
-
-
-    procedure taicpu.ResetPass2;
-      begin
-        { we are here in a second pass, check if the instruction can be optimized }
-        if assigned(InsEntry) and
-           ((InsEntry^.flags and IF_PASS2)<>0) then
-         begin
-           InsEntry:=nil;
-           InsSize:=0;
-         end;
-        LastInsOffset:=-1;
-      end;
-
-
-    function taicpu.CheckIfValid:boolean;
-      begin
-      end;
-
-
-    function taicpu.Pass1(offset:longint):longint;
-      var
-        ldr2op : array[PF_B..PF_T] of tasmop = (
-          A_LDRB,A_LDRSB,A_LDRBT,A_LDRH,A_LDRSH,A_LDRT);
-        str2op : array[PF_B..PF_T] of tasmop = (
-          A_STRB,A_None,A_STRBT,A_STRH,A_None,A_STRT);
-      begin
-        Pass1:=0;
-        { Save the old offset and set the new offset }
-        InsOffset:=Offset;
-        { Error? }
-        if (Insentry=nil) and (InsSize=-1) then
-          exit;
-        { set the file postion }
-        aktfilepos:=fileinfo;
-
-        { tranlate LDR+postfix to complete opcode }
-        if (opcode=A_LDR) and (oppostfix<>PF_None) then
-          begin
-            if (oppostfix in [low(ldr2op)..high(ldr2op)]) then
-              opcode:=ldr2op[oppostfix]
-            else
-              internalerror(2005091001);
-            if opcode=A_None then
-              internalerror(2005091004);
-            { postfix has been added to opcode }
-            oppostfix:=PF_None;
-          end
-        else if (opcode=A_STR) and (oppostfix<>PF_None) then
-          begin
-            if (oppostfix in [low(str2op)..high(str2op)]) then
-              opcode:=str2op[oppostfix]
-            else
-              internalerror(2005091002);
-            if opcode=A_None then
-              internalerror(2005091003);
-            { postfix has been added to opcode }
-            oppostfix:=PF_None;
-          end;
-
-        { Get InsEntry }
-        if FindInsEntry then
-         begin
-           InsSize:=4;
-           LastInsOffset:=InsOffset;
-           Pass1:=InsSize;
-           exit;
-         end;
-        LastInsOffset:=-1;
-      end;
-
-
-    procedure taicpu.Pass2(objdata:TAsmObjectdata);
-      begin
-        { error in pass1 ? }
-        if insentry=nil then
-         exit;
-        aktfilepos:=fileinfo;
-        { Generate the instruction }
-        GenCode(objdata);
-      end;
-
-
-    procedure taicpu.ppuloadoper(ppufile:tcompilerppufile;var o:toper);
-      begin
-      end;
-
-
-    procedure taicpu.ppuwriteoper(ppufile:tcompilerppufile;const o:toper);
-      begin
-      end;
-
-
-    procedure taicpu.ppubuildderefimploper(var o:toper);
-      begin
-      end;
-
-
-    procedure taicpu.ppuderefoper(var o:toper);
-      begin
-      end;
-
-
-    function  taicpu.InsEnd:longint;
-      begin
-      end;
-
-
-    procedure taicpu.create_ot;
-      var
-        i,l,relsize : longint;
-        dummy : byte;
-      begin
-        if ops=0 then
-         exit;
-        { update oper[].ot field }
-        for i:=0 to ops-1 do
-         with oper[i]^ do
-          begin
-            case typ of
-              top_regset:
-                begin
-                  ot:=OT_REGLIST;
-                end;
-              top_reg :
-                begin
-                  case getregtype(reg) of
-                    R_INTREGISTER:
-                      ot:=OT_REG32 or OT_SHIFTEROP;
-                    R_FPUREGISTER:
-                      ot:=OT_FPUREG;
-                    else
-                      internalerror(2005090901);
-                  end;
-                end;
-              top_ref :
-                begin
-                  if ref^.refaddr=addr_no then
-                    begin
-                      { create ot field }
-                      { we should get the size here dependend on the
-                        instruction }
-                      if (ot and OT_SIZE_MASK)=0 then
-                        ot:=OT_MEMORY or OT_BITS32
-                      else
-                        ot:=OT_MEMORY or (ot and OT_SIZE_MASK);
-                      if (ref^.base=NR_NO) and (ref^.index=NR_NO) then
-                        ot:=ot or OT_MEM_OFFS;
-                      { if we need to fix a reference, we do it here }
-
-                      { pc relative addressing }
-                      if (ref^.base=NR_NO) and
-                        (ref^.index=NR_NO) and
-                        (ref^.shiftmode=SM_None)
-                        { at least we should check if the destination symbol
-                          is in a text section }
-                        { and
-                        (ref^.symbol^.owner="text") } then
-                        ref^.base:=NR_PC;
-
-                      { determine possible address modes }
-                      if (ref^.base<>NR_NO) and
-                        (
-                          (
-                            (ref^.index=NR_NO) and
-                            (ref^.shiftmode=SM_None) and
-                            (ref^.offset>=-4097) and
-                            (ref^.offset<=4097)
-                          ) or
-                          (
-                            (ref^.shiftmode=SM_None) and
-                            (ref^.offset=0)
-                          ) or
-                          (
-                            (ref^.index<>NR_NO) and
-                            (ref^.shiftmode<>SM_None) and
-                            (ref^.shiftimm<=31) and
-                            (ref^.offset=0)
-                          )
-                        ) then
-                        ot:=ot or OT_AM2;
-
-                      if (ref^.index<>NR_NO) and
-                        (oppostfix in [PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA]) and
-                        (
-                          (ref^.base=NR_NO) and
-                          (ref^.shiftmode=SM_None) and
-                          (ref^.offset=0)
-                        ) then
-                        ot:=ot or OT_AM4;
-
-                    end
-                  else
-                    begin
-                      l:=ref^.offset;
-                      if assigned(ref^.symbol) then
-                        inc(l,ref^.symbol.address);
-                      relsize:=(InsOffset+2)-l;
-                      if (relsize<-33554428) or (relsize>33554428) then
-                       ot:=OT_IMM32
-                      else
-                       ot:=OT_IMM24;
-                    end;
-                end;
-              top_local :
-                begin
-                  { we should get the size here dependend on the
-                    instruction }
-                  if (ot and OT_SIZE_MASK)=0 then
-                    ot:=OT_MEMORY or OT_BITS32
-                  else
-                    ot:=OT_MEMORY or (ot and OT_SIZE_MASK);
-                end;
-              top_const :
-                begin
-                  ot:=OT_IMMEDIATE;
-                  if is_shifter_const(val,dummy) then
-                    ot:=OT_IMMSHIFTER
-                  else
-                    ot:=OT_IMM32
-                end;
-              top_none :
-                begin
-                  { generated when there was an error in the
-                    assembler reader. It never happends when generating
-                    assembler }
-                end;
-              top_shifterop:
-                begin
-                  ot:=OT_SHIFTEROP;
-                end;
-              else
-                internalerror(200402261);
-            end;
-          end;
-      end;
-
-
-    function taicpu.Matches(p:PInsEntry):longint;
-      { * IF_SM stands for Size Match: any operand whose size is not
-       * explicitly specified by the template is `really' intended to be
-       * the same size as the first size-specified operand.
-       * Non-specification is tolerated in the input instruction, but
-       * _wrong_ specification is not.
-       *
-       * IF_SM2 invokes Size Match on only the first _two_ operands, for
-       * three-operand instructions such as SHLD: it implies that the
-       * first two operands must match in size, but that the third is
-       * required to be _unspecified_.
-       *
-       * IF_SB invokes Size Byte: operands with unspecified size in the
-       * template are really bytes, and so no non-byte specification in
-       * the input instruction will be tolerated. IF_SW similarly invokes
-       * Size Word, and IF_SD invokes Size Doubleword.
-       *
-       * (The default state if neither IF_SM nor IF_SM2 is specified is
-       * that any operand with unspecified size in the template is
-       * required to have unspecified size in the instruction too...)
-      }
-      var
-        i,j,asize,oprs : longint;
-        siz : array[0..3] of longint;
-      begin
-        Matches:=100;
-        writeln(getstring,'---');
-
-        { Check the opcode and operands }
-        if (p^.opcode<>opcode) or (p^.ops<>ops) then
-         begin
-           Matches:=0;
-           exit;
-         end;
-
-        { Check that no spurious colons or TOs are present }
-        for i:=0 to p^.ops-1 do
-         if (oper[i]^.ot and (not p^.optypes[i]) and (OT_COLON or OT_TO))<>0 then
-          begin
-            Matches:=0;
-            exit;
-          end;
-
-        { Check that the operand flags all match up }
-        for i:=0 to p^.ops-1 do
-         begin
-           if ((p^.optypes[i] and (not oper[i]^.ot)) or
-               ((p^.optypes[i] and OT_SIZE_MASK) and
-                ((p^.optypes[i] xor oper[i]^.ot) and OT_SIZE_MASK)))<>0 then
-            begin
-              if ((p^.optypes[i] and (not oper[i]^.ot) and OT_NON_SIZE) or
-                  (oper[i]^.ot and OT_SIZE_MASK))<>0 then
-               begin
-                 Matches:=0;
-                 exit;
-               end
-              else
-               Matches:=1;
-            end;
-         end;
-
-      { check postfixes:
-        the existance of a certain postfix requires a
-        particular code }
-
-        { update condition flags
-          or floating point single }
-      if (oppostfix=PF_S) and
-        not(p^.code[0] in [#$04]) then
-        begin
-          Matches:=0;
-          exit;
-        end;
-
-      { floating point size }
-      if (oppostfix in [PF_D,PF_E,PF_P,PF_EP]) and
-        not(p^.code[0] in []) then
-        begin
-          Matches:=0;
-          exit;
-        end;
-
-      { multiple load/store address modes }
-      if (oppostfix in [PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA]) and
-        not(p^.code[0] in [
-          // ldr,str,ldrb,strb
-          #$17,
-          // stm,ldm
-          #$26
-        ]) then
-        begin
-          Matches:=0;
-          exit;
-        end;
-
-      { we shouldn't see any opsize prefixes here }
-      if (oppostfix in [PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T]) then
-        begin
-          Matches:=0;
-          exit;
-        end;
-
-      if (roundingmode<>RM_None) and not(p^.code[0] in []) then
-        begin
-          Matches:=0;
-          exit;
-        end;
-
-      { Check operand sizes }
-        { as default an untyped size can get all the sizes, this is different
-          from nasm, but else we need to do a lot checking which opcodes want
-          size or not with the automatic size generation }
-        asize:=longint($ffffffff);
-        (*
-        if (p^.flags and IF_SB)<>0 then
-          asize:=OT_BITS8
-        else if (p^.flags and IF_SW)<>0 then
-          asize:=OT_BITS16
-        else if (p^.flags and IF_SD)<>0 then
-          asize:=OT_BITS32;
-        if (p^.flags and IF_ARMASK)<>0 then
-         begin
-           siz[0]:=0;
-           siz[1]:=0;
-           siz[2]:=0;
-           if (p^.flags and IF_AR0)<>0 then
-            siz[0]:=asize
-           else if (p^.flags and IF_AR1)<>0 then
-            siz[1]:=asize
-           else if (p^.flags and IF_AR2)<>0 then
-            siz[2]:=asize;
-         end
-        else
-         begin
-         { we can leave because the size for all operands is forced to be
-           the same
-           but not if IF_SB IF_SW or IF_SD is set PM }
-           if asize=-1 then
-             exit;
-           siz[0]:=asize;
-           siz[1]:=asize;
-           siz[2]:=asize;
-         end;
-
-        if (p^.flags and (IF_SM or IF_SM2))<>0 then
-         begin
-           if (p^.flags and IF_SM2)<>0 then
-            oprs:=2
-           else
-            oprs:=p^.ops;
-           for i:=0 to oprs-1 do
-            if ((p^.optypes[i] and OT_SIZE_MASK) <> 0) then
-             begin
-               for j:=0 to oprs-1 do
-                siz[j]:=p^.optypes[i] and OT_SIZE_MASK;
-               break;
-             end;
-          end
-         else
-          oprs:=2;
-
-        { Check operand sizes }
-        for i:=0 to p^.ops-1 do
-         begin
-           if ((p^.optypes[i] and OT_SIZE_MASK)=0) and
-              ((oper[i]^.ot and OT_SIZE_MASK and (not siz[i]))<>0) and
-              { Immediates can always include smaller size }
-              ((oper[i]^.ot and OT_IMMEDIATE)=0) and
-               (((p^.optypes[i] and OT_SIZE_MASK) or siz[i])<(oper[i]^.ot and OT_SIZE_MASK)) then
-            Matches:=2;
-         end;
-        *)
-      end;
-
-
-    function  taicpu.calcsize(p:PInsEntry):shortint;
-      begin
-        result:=4;
-      end;
-
-
-    function  taicpu.NeedAddrPrefix(opidx:byte):boolean;
-      begin
-      end;
-
-
-    procedure taicpu.Swapoperands;
-      begin
-      end;
-
-
-    function taicpu.FindInsentry:boolean;
-      var
-        i : longint;
-      begin
-        result:=false;
-      { Things which may only be done once, not when a second pass is done to
-        optimize }
-        if (Insentry=nil) or ((InsEntry^.flags and IF_PASS2)<>0) then
-         begin
-           { create the .ot fields }
-           create_ot;
-           { set the file postion }
-           aktfilepos:=fileinfo;
-         end
-        else
-         begin
-           { we've already an insentry so it's valid }
-           result:=true;
-           exit;
-         end;
-        { Lookup opcode in the table }
-        InsSize:=-1;
-        i:=instabcache^[opcode];
-        if i=-1 then
-         begin
-           Message1(asmw_e_opcode_not_in_table,gas_op2str[opcode]);
-           exit;
-         end;
-        insentry:=@instab[i];
-        while (insentry^.opcode=opcode) do
-         begin
-           if matches(insentry)=100 then
-             begin
-               result:=true;
-               exit;
-             end;
-           inc(i);
-           insentry:=@instab[i];
-         end;
-        Message1(asmw_e_invalid_opcode_and_operands,GetString);
-        { No instruction found, set insentry to nil and inssize to -1 }
-        insentry:=nil;
-        inssize:=-1;
-      end;
-
-
-    procedure taicpu.gencode(objdata:TAsmObjectData);
-      var
-        bytes : dword;
-        i_field : byte;
-
-      procedure setshifterop(op : byte);
-        begin
-          case oper[op]^.typ of
-            top_const:
-              begin
-                i_field:=1;
-                bytes:=bytes or (oper[op]^.val and $fff);
-              end;
-            top_reg:
-              begin
-                i_field:=0;
-                bytes:=bytes or (getsupreg(oper[op]^.reg) shl 16);
-
-                { does a real shifter op follow? }
-                if (op+1<=op) and (oper[op+1]^.typ=top_shifterop) then
-                  begin
-                  end;
-              end;
-          else
-            internalerror(2005091103);
-          end;
-        end;
-
-      begin
-        bytes:=$0;
-        { evaluate and set condition code }
-
-        { condition code allowed? }
-
-        { setup rest of the instruction }
-        case insentry^.code[0] of
-          #$08:
-            begin
-              { set instruction code }
-              bytes:=bytes or (ord(insentry^.code[1]) shl 26);
-              bytes:=bytes or (ord(insentry^.code[2]) shl 21);
-
-              { set destination }
-              bytes:=bytes or (getsupreg(oper[0]^.reg) shl 12);
-
-              { create shifter op }
-              setshifterop(1);
-
-              { set i field }
-              bytes:=bytes or (i_field shl 25);
-
-              { set s if necessary }
-              if oppostfix=PF_S then
-                bytes:=bytes or (1 shl 20);
-            end;
-          #$ff:
-            internalerror(2005091101);
-          else
-            internalerror(2005091102);
-        end;
-        { we're finished, write code }
-        objdata.writebytes(bytes,sizeof(bytes));
-      end;
-
-
-end.
-
-{$ifdef dummy}
-      (*
-static void gencode (long segment, long offset, int bits,
-		     insn *ins, char *codes, long insn_end)
-{
-    int has_S_code;		/* S - setflag */
-    int has_B_code;		/* B - setflag */
-    int has_T_code;		/* T - setflag */
-    int has_W_code;		/* ! => W flag */
-    int has_F_code;		/* ^ => S flag */
-    int keep;
-    unsigned char c;
-    unsigned char bytes[4];
-    long          data, size;
-    static int cc_code[] =	/* bit pattern of cc */
-  {				/* order as enum in  */
-    0x0E, 0x03, 0x02, 0x00,	/* nasm.h	     */
-    0x0A, 0x0C, 0x08, 0x0D,
-    0x09, 0x0B, 0x04, 0x01,
-    0x05, 0x07, 0x06,
-  };
-
-(*
-#ifdef DEBUG
-static char *CC[] =
-  {				       /* condition code names */
-    "AL", "CC", "CS", "EQ",
-    "GE", "GT", "HI", "LE",
-    "LS", "LT", "MI", "NE",
-    "PL", "VC", "VS", "",
-    "S"
-};
-*)
-
-    has_S_code = (ins->condition & C_SSETFLAG);
-    has_B_code = (ins->condition & C_BSETFLAG);
-    has_T_code = (ins->condition & C_TSETFLAG);
-    has_W_code = (ins->condition & C_EXSETFLAG);
-    has_F_code = (ins->condition & C_FSETFLAG);
-    ins->condition = (ins->condition & 0x0F);
-
-(*
-    if (rt_debug)
-      {
-    printf ("gencode: instruction: %s%s", insn_names[ins->opcode],
-	    CC[ins->condition & 0x0F]);
-    if (has_S_code)
-      printf ("S");
-    if (has_B_code)
-      printf ("B");
-    if (has_T_code)
-      printf ("T");
-    if (has_W_code)
-      printf ("!");
-    if (has_F_code)
-      printf ("^");
-
-    printf ("\n");
-
-    c = *codes;
-
-    printf ("   (%d)  decode - '0x%02X'\n", ins->operands, c);
-
-
-    bytes[0] = 0xB;
-    bytes[1] = 0xE;
-    bytes[2] = 0xE;
-    bytes[3] = 0xF;
-      }
-*)
-    // First condition code in upper nibble
-    if (ins->condition < C_NONE)
-      {
-	c = cc_code[ins->condition] << 4;
-      }
-    else
-      {
-	c = cc_code[C_AL] << 4;	// is often ALWAYS but not always
-      }
-
-
-    switch (keep = *codes)
-      {
-	case 1:
-	  // B, BL
-	  ++codes;
-	  c |= *codes++;
-	  bytes[0] = c;
-
-	  if (ins->oprs[0].segment != segment)
-	    {
-	      // fais une relocation
-	      c = 1;
-	      data = 0;	// Let the linker locate ??
-	    }
-	  else
-	    {
-	      c = 0;
-	      data = ins->oprs[0].offset - (offset + 8);
-	
-	      if (data % 4)
-		{
-		  errfunc (ERR_NONFATAL, "offset not aligned on 4 bytes");
-		}
-	    }
-	
-	  if (data >= 0x1000)
-	    {
-	      errfunc (ERR_NONFATAL, "too long offset");
-	    }
-
-	  data = data >> 2;
-	  bytes[1] = (data >> 16) & 0xFF;
-	  bytes[2] = (data >> 8)  & 0xFF;
-	  bytes[3] = (data )      & 0xFF;
-
-	  if (c == 1)
-	    {
-//	      out (offset, segment, &bytes[0], OUT_RAWDATA+1, NO_SEG, NO_SEG);
-	      out (offset, segment, &bytes[0], OUT_REL3ADR+4, ins->oprs[0].segment, NO_SEG);
-	    }
-	  else
-	    {
-	      out (offset, segment, &bytes[0], OUT_RAWDATA+4, NO_SEG, NO_SEG);
-	    }
-	  return;
-
-	case 2:
-	  // SWI
-	  ++codes;
-	  c |= *codes++;
-	  bytes[0] = c;
-	  data = ins->oprs[0].offset;
-	  bytes[1] = (data >> 16) & 0xFF;
-	  bytes[2] = (data >> 8) & 0xFF;
-	  bytes[3] = (data) & 0xFF;
-	  out (offset, segment, &bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG);
-	  return;
-        case 3:
-	  // BX
-	  ++codes;
-	  c |= *codes++;
-	  bytes[0] = c;
-	  bytes[1] = *codes++;
-	  bytes[2] = *codes++;
-	  bytes[3] = *codes++;
-	  c = regval (&ins->oprs[0],1);
-	  if (c == 15)	// PC
-	    {
-	      errfunc (ERR_WARNING, "'BX' with R15 has undefined behaviour");
-	    }
-	  else if (c > 15)
-	    {
-	      errfunc (ERR_NONFATAL, "Illegal register specified for 'BX'");
-	    }
-
-	  bytes[3] |= (c & 0x0F);
-	  out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG);
-	  return;
-
-        case 4:		// AND Rd,Rn,Rm
-        case 5:		// AND Rd,Rn,Rm,<shift>Rs
-        case 6:		// AND Rd,Rn,Rm,<shift>imm
-        case 7:		// AND Rd,Rn,<shift>imm
-	  ++codes;
-#ifdef DEBUG
-	  if (rt_debug)
-	    {
-	      printf ("         decode - '0x%02X'\n", keep);
-	      printf ("           code - '0x%02X'\n", (unsigned char) ( *codes));
-	    }
-#endif
-	  bytes[0] = c | *codes;
-	  ++codes;
-	
-	  bytes[1] = *codes;
-	  if (has_S_code)
-	    bytes[1] |= 0x10;
-	  c = regval (&ins->oprs[1],1);
-	  // Rn in low nibble
-	  bytes[1] |= c;
-
-	  // Rd in high nibble
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-
-	  if (keep != 7)
-	    {
-	      // Rm in low nibble
-	      bytes[3] = regval (&ins->oprs[2],1);
-	    }
-
-	  // Shifts if any
-	  if (keep == 5 || keep == 6)
-	    {
-	      // Shift in bytes 2 and 3
-	      if (keep == 5)
-		{
-		  // Rs
-		  c = regval (&ins->oprs[3],1);
-		  bytes[2] |= c;
-
-		  c = 0x10;		// Set bit 4 in byte[3]
-		}
-	      if (keep == 6)
-		{
-		  c = (ins->oprs[3].offset) & 0x1F;
-
-		  // #imm
-		  bytes[2] |= c >> 1;
-		  if (c & 0x01)
-		    {
-		      bytes[3] |= 0x80;
-		    }
-		  c = 0;		// Clr bit 4 in byte[3]
-		}
-	      // <shift>
-	      c |= shiftval (&ins->oprs[3]) << 5;
-
-	      bytes[3] |= c;
-	    }
-	
-	  // reg,reg,imm
-	  if (keep == 7)
-	    {
-	      int shimm;
-	
-	      shimm = imm_shift (ins->oprs[2].offset);
-
-	      if (shimm == -1)
-		{
-		  errfunc (ERR_NONFATAL, "cannot create that constant");
-		}
-	      bytes[3] = shimm & 0xFF;
-	      bytes[2] |= (shimm & 0xF00) >> 8;
-	    }
-	
-	  out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG);
-	  return;
-
-        case 8:		// MOV Rd,Rm
-        case 9:		// MOV Rd,Rm,<shift>Rs
-        case 0xA:	// MOV Rd,Rm,<shift>imm
-        case 0xB:	// MOV Rd,<shift>imm
-	  ++codes;
-#ifdef DEBUG
-	  if (rt_debug)
-	    {
-	      printf ("         decode - '0x%02X'\n", keep);
-	      printf ("           code - '0x%02X'\n", (unsigned char) ( *codes));
-	    }
-#endif
-	  bytes[0] = c | *codes;
-	  ++codes;
-	
-	  bytes[1] = *codes;
-	  if (has_S_code)
-	    bytes[1] |= 0x10;
-
-	  // Rd in high nibble
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-
-	  if (keep != 0x0B)
-	    {
-	      // Rm in low nibble
-	      bytes[3] = regval (&ins->oprs[1],1);
-	    }
-
-	  // Shifts if any
-	  if (keep == 0x09 || keep == 0x0A)
-	    {
-	      // Shift in bytes 2 and 3
-	      if (keep == 0x09)
-		{
-		  // Rs
-		  c = regval (&ins->oprs[2],1);
-		  bytes[2] |= c;
-
-		  c = 0x10;		// Set bit 4 in byte[3]
-		}
-	      if (keep == 0x0A)
-		{
-		  c = (ins->oprs[2].offset) & 0x1F;
-		
-		  // #imm
-		  bytes[2] |= c >> 1;
-		  if (c & 0x01)
-		    {
-		      bytes[3] |= 0x80;
-		    }
-		  c = 0;		// Clr bit 4 in byte[3]
-		}
-	      // <shift>
-	      c |= shiftval (&ins->oprs[2]) << 5;
-
-	      bytes[3] |= c;
-	    }
-	
-	  // reg,imm
-	  if (keep == 0x0B)
-	    {
-	      int shimm;
-	
-	      shimm = imm_shift (ins->oprs[1].offset);
-
-	      if (shimm == -1)
-		{
-		  errfunc (ERR_NONFATAL, "cannot create that constant");
-		}
-	      bytes[3] = shimm & 0xFF;
-	      bytes[2] |= (shimm & 0xF00) >> 8;
-	    }
-	
-	  out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG);
-	  return;
-
-
-        case 0xC:	// CMP Rn,Rm
-        case 0xD:	// CMP Rn,Rm,<shift>Rs
-        case 0xE:	// CMP Rn,Rm,<shift>imm
-        case 0xF:	// CMP Rn,<shift>imm
-	  ++codes;
-
-	  bytes[0] = c | *codes++;
-	
-	  bytes[1] = *codes;
-
-	  // Implicit S code
-	  bytes[1] |= 0x10;
-
-	  c = regval (&ins->oprs[0],1);
-	  // Rn in low nibble
-	  bytes[1] |= c;
-
-	  // No destination
-	  bytes[2] = 0;
-
-	  if (keep != 0x0B)
-	    {
-	      // Rm in low nibble
-	      bytes[3] = regval (&ins->oprs[1],1);
-	    }
-
-	  // Shifts if any
-	  if (keep == 0x0D || keep == 0x0E)
-	    {
-	      // Shift in bytes 2 and 3
-	      if (keep == 0x0D)
-		{
-		  // Rs
-		  c = regval (&ins->oprs[2],1);
-		  bytes[2] |= c;
-
-		  c = 0x10;		// Set bit 4 in byte[3]
-		}
-	      if (keep == 0x0E)
-		{
-		  c = (ins->oprs[2].offset) & 0x1F;
-		
-		  // #imm
-		  bytes[2] |= c >> 1;
-		  if (c & 0x01)
-		    {
-		      bytes[3] |= 0x80;
-		    }
-		  c = 0;		// Clr bit 4 in byte[3]
-		}
-	      // <shift>
-	      c |= shiftval (&ins->oprs[2]) << 5;
-
-	      bytes[3] |= c;
-	    }
-	
-	  // reg,imm
-	  if (keep == 0x0F)
-	    {
-	      int shimm;
-	
-	      shimm = imm_shift (ins->oprs[1].offset);
-
-	      if (shimm == -1)
-		{
-		  errfunc (ERR_NONFATAL, "cannot create that constant");
-		}
-	      bytes[3] = shimm & 0xFF;
-	      bytes[2] |= (shimm & 0xF00) >> 8;
-	    }
-	
-	  out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG);
-	  return;
-	
-        case 0x10:	// MRS Rd,<psr>
-	  ++codes;
-
-	  bytes[0] = c | *codes++;
-	
-	  bytes[1] = *codes++;
-
-	  // Rd
-	  c = regval (&ins->oprs[0],1);
-
-	  bytes[2] = c << 4;
-
-	  bytes[3] = 0;
-
-	  c = ins->oprs[1].basereg;
-
-	  if (c == R_CPSR || c == R_SPSR)
-	    {
-	      if (c == R_SPSR)
-		{
-		  bytes[1] |= 0x40;
-		}
-	    }
-	  else
-	    {
-	      errfunc (ERR_NONFATAL, "CPSR or SPSR expected");
-	    }
-
-	  out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG);
-
-	  return;
-	
-        case 0x11:	// MSR <psr>,Rm
-	case 0x12:	// MSR <psrf>,Rm
-        case 0x13:	// MSR <psrf>,#expression
-	  ++codes;
-
-	  bytes[0] = c | *codes++;
-	
-	  bytes[1] = *codes++;
-
-	  bytes[2] = *codes;
-
-
-	  if (keep == 0x11 || keep == 0x12)
-	    {
-	      // Rm
-	      c = regval (&ins->oprs[1],1);
-
-	      bytes[3] = c;
-	    }
-	  else
-	    {
-	      int shimm;
-	
-	      shimm = imm_shift (ins->oprs[1].offset);
-
-	      if (shimm == -1)
-		{
-		  errfunc (ERR_NONFATAL, "cannot create that constant");
-		}
-	      bytes[3] = shimm & 0xFF;
-	      bytes[2] |= (shimm & 0xF00) >> 8;
-	    }
-	
-	  c = ins->oprs[0].basereg;
-
-	  if ( keep == 0x11)
-	    {
-	      if ( c == R_CPSR || c == R_SPSR)
-		{
-		if ( c== R_SPSR)
-		  {
-		    bytes[1] |= 0x40;
-		  }
-		}
-	    else
-	      {
-		errfunc (ERR_NONFATAL, "CPSR or SPSR expected");
-	      }
-	    }
-	  else
-	    {
-	      if ( c == R_CPSR_FLG || c == R_SPSR_FLG)
-		{
-		  if ( c== R_SPSR_FLG)
-		    {
-		      bytes[1] |= 0x40;
-		    }
-		}
-	      else
-		{
-		  errfunc (ERR_NONFATAL, "CPSR_flg or SPSR_flg expected");
-		}
-	    }
-	  break;
-
-        case 0x14:	// MUL  Rd,Rm,Rs
-        case 0x15:	// MULA Rd,Rm,Rs,Rn
-	  ++codes;
-
-	  bytes[0] = c | *codes++;
-	
-	  bytes[1] = *codes++;
-
-	  bytes[3] = *codes;
-
-	  // Rd
-	  bytes[1] |= regval (&ins->oprs[0],1);
-	  if (has_S_code)
-	    bytes[1] |= 0x10;
-
-	  // Rm
-	  bytes[3] |= regval (&ins->oprs[1],1);
-
-	  // Rs
-	  bytes[2] = regval (&ins->oprs[2],1);
-
-	  if (keep == 0x15)
-	    {
-	      bytes[2] |= regval (&ins->oprs[3],1) << 4;
-	    }
-	  break;
-
-        case 0x16:	// SMLAL RdHi,RdLo,Rm,Rs
-	  ++codes;
-	
-	  bytes[0] = c | *codes++;
-
-	  bytes[1] = *codes++;
-
-	  bytes[3] = *codes;
-
-	  // RdHi
-	  bytes[1] |= regval (&ins->oprs[1],1);
-	  if (has_S_code)
-	    bytes[1] |= 0x10;
-
-	  // RdLo
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-	  // Rm
-	  bytes[3] |= regval (&ins->oprs[2],1);
-
-	  // Rs
-	  bytes[2] |= regval (&ins->oprs[3],1);
-
-	  break;
-	
-        case 0x17:	// LDR Rd, expression
-	  ++codes;
-
-	  bytes[0] = c | *codes++;
-
-	  bytes[1] = *codes++;
-
-	  // Rd
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-	  if (has_B_code)
-	    bytes[1] |= 0x40;
-	  if (has_T_code)
-	    {
-	      errfunc (ERR_NONFATAL, "'T' not allowed in pre-index mode");
-	    }
-	  if (has_W_code)
-	    {
-	      errfunc (ERR_NONFATAL, "'!' not allowed");
-	    }
-
-	  // Rn - implicit R15
-	  bytes[1] |= 0xF;
-
-	  if (ins->oprs[1].segment != segment)
-	    {
-	      errfunc (ERR_NONFATAL, "label not in same segment");
-	    }
-	
-	  data = ins->oprs[1].offset - (offset + 8);
-
-	  if (data < 0)
-	    {
-	      data = -data;
-	    }
-	  else
-	    {
-	      bytes[1] |= 0x80;
-	    }
-
-	  if (data >= 0x1000)
-	    {
-	      errfunc (ERR_NONFATAL, "too long offset");
-	    }
-
-	  bytes[2] |= ((data & 0xF00) >> 8);
-	  bytes[3] = data & 0xFF;
-	  break;
-	
-        case 0x18:	// LDR Rd, [Rn]
-	  ++codes;
-	
-	  bytes[0] = c | *codes++;
-	
-	  bytes[1] = *codes++;
-
-	  // Rd
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-	  if (has_B_code)
-	    bytes[1] |= 0x40;
-	  if (has_T_code)
-	    {
-	      bytes[1] |= 0x20;		// write-back
-	    }
-	  else
-	    {
-	      bytes[0] |= 0x01;		// implicit pre-index mode
-	    }
-
-	  if (has_W_code)
-	    {
-	      bytes[1] |= 0x20;		// write-back
-	    }
-
-	  // Rn
-	  c = regval (&ins->oprs[1],1);
-	  bytes[1] |= c;
-
-	  if (c == 0x15)		// R15
-	    data = -8;
-	  else
-	    data = 0;
-
-	  if (data < 0)
-	    {
-	      data = -data;
-	    }
-	  else
-	    {
-	      bytes[1] |= 0x80;
-	    }
-
-	  bytes[2] |= ((data & 0xF00) >> 8);
-	  bytes[3] = data & 0xFF;
-	  break;
-	
-        case 0x19:	// LDR Rd, [Rn,#expression]
-	case 0x20:	// LDR Rd, [Rn,Rm]
-	case 0x21:	// LDR Rd, [Rn,Rm,shift]
-	  ++codes;
-	
-	  bytes[0] = c | *codes++;
-	
-	  bytes[1] = *codes++;
-
-	  // Rd
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-	  if (has_B_code)
-	    bytes[1] |= 0x40;
-
-	  // Rn
-	  c = regval (&ins->oprs[1],1);
-	  bytes[1] |= c;
-
-	  if (ins->oprs[ins->operands-1].bracket)	// FIXME: Bracket on last operand -> pre-index  <--
-	    {
-	      bytes[0] |= 0x01;		// pre-index mode
-	      if (has_W_code)
-		{
-		  bytes[1] |= 0x20;
-		}
-	      if (has_T_code)
-		{
-		  errfunc (ERR_NONFATAL, "'T' not allowed in pre-index mode");
-		}
-	    }
-	  else
-	    {
-	      if (has_T_code)		// Forced write-back in post-index mode
-		{
-		  bytes[1] |= 0x20;
-		}
-	      if (has_W_code)
-		{
-		  errfunc (ERR_NONFATAL, "'!' not allowed in post-index mode");
-		}
-	    }
-
-	  if (keep == 0x19)
-	    {
-	      data = ins->oprs[2].offset;
-
-	      if (data < 0)
-		{
-		  data = -data;
-		}
-	      else
-		{
-		  bytes[1] |= 0x80;
-		}
-
-	      if (data >= 0x1000)
-		{
-		  errfunc (ERR_NONFATAL, "too long offset");
-		}
-	
-	      bytes[2] |= ((data & 0xF00) >> 8);
-	      bytes[3] = data & 0xFF;
-	    }
-	  else
-	    {
-	      if (ins->oprs[2].minus == 0)
-		{
-		  bytes[1] |= 0x80;
-		}
-	      c = regval (&ins->oprs[2],1);
-	      bytes[3] = c;
-
-	      if (keep == 0x21)
-		{
-		  c = ins->oprs[3].offset;
-		  if (c > 0x1F)
-		    {
-		      errfunc (ERR_NONFATAL, "too large shiftvalue");
-		      c = c & 0x1F;
-		    }
-		
-		  bytes[2] |= c >> 1;
-		  if (c & 0x01)
-		    {
-		      bytes[3] |= 0x80;
-		    }
-		  bytes[3] |= shiftval (&ins->oprs[3]) << 5;
-		}
-	    }
-	
-	  break;
-	
-        case 0x22:	// LDRH Rd, expression
-	  ++codes;
-	
-	  bytes[0] = c | 0x01;		// Implicit pre-index
-
-	  bytes[1] = *codes++;
-
-	  // Rd
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-	
-	  // Rn - implicit R15
-	  bytes[1] |= 0xF;
-
-	  if (ins->oprs[1].segment != segment)
-	    {
-	      errfunc (ERR_NONFATAL, "label not in same segment");
-	    }
-	
-	  data = ins->oprs[1].offset - (offset + 8);
-
-	  if (data < 0)
-	    {
-	      data = -data;
-	    }
-	  else
-	    {
-	      bytes[1] |= 0x80;
-	    }
-
-	  if (data >= 0x100)
-	    {
-	      errfunc (ERR_NONFATAL, "too long offset");
-	    }
-	  bytes[3] = *codes++;
-
-	  bytes[2] |= ((data & 0xF0) >> 4);
-	  bytes[3] |= data & 0xF;
-	  break;
-	
-        case 0x23:	// LDRH Rd, Rn
-	  ++codes;
-	
-	  bytes[0] = c | 0x01;		// Implicit pre-index
-	
-	  bytes[1] = *codes++;
-
-	  // Rd
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-	
-	  // Rn
-	  c = regval (&ins->oprs[1],1);
-	  bytes[1] |= c;
-
-	  if (c == 0x15)		// R15
-	    data = -8;
-	  else
-	    data = 0;
-
-	  if (data < 0)
-	    {
-	      data = -data;
-	    }
-	  else
-	    {
-	      bytes[1] |= 0x80;
-	    }
-
-	  if (data >= 0x100)
-	    {
-	      errfunc (ERR_NONFATAL, "too long offset");
-	    }
-	  bytes[3] = *codes++;
-
-	  bytes[2] |= ((data & 0xF0) >> 4);
-	  bytes[3] |= data & 0xF;
-	  break;
-	
-        case 0x24:	// LDRH Rd, Rn, expression
-        case 0x25:	// LDRH Rd, Rn, Rm
-	  ++codes;
-
-	  bytes[0] = c;
-	
-	  bytes[1] = *codes++;
-
-	  // Rd
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-
-	  // Rn
-	  c = regval (&ins->oprs[1],1);
-	  bytes[1] |= c;
-
-	  if (ins->oprs[ins->operands-1].bracket)	// FIXME: Bracket on last operand -> pre-index  <--
-	    {
-	      bytes[0] |= 0x01;		// pre-index mode
-	      if (has_W_code)
-		{
-		  bytes[1] |= 0x20;
-		}
-	    }
-	  else
-	    {
-	      if (has_W_code)
-		{
-		  errfunc (ERR_NONFATAL, "'!' not allowed in post-index mode");
-		}
-	    }
-
-	  bytes[3] = *codes++;
-
-	  if (keep == 0x24)
-	    {
-	      data = ins->oprs[2].offset;
-
-	      if (data < 0)
-		{
-		  data = -data;
-		}
-	      else
-		{
-		  bytes[1] |= 0x80;
-		}
-	
-	      if (data >= 0x100)
-		{
-		  errfunc (ERR_NONFATAL, "too long offset");
-		}
-
-	      bytes[2] |= ((data & 0xF0) >> 4);
-	      bytes[3] |= data & 0xF;
-	    }
-	  else
-	    {
-	      if (ins->oprs[2].minus == 0)
-		{
-		  bytes[1] |= 0x80;
-		}
-	      c = regval (&ins->oprs[2],1);
-	      bytes[3] |= c;
-
-	    }
-	  break;
-	
-        case 0x26:	// LDM/STM Rn, {reg-list}
-	  ++codes;
-
-	  bytes[0] = c;
-
-	  bytes[0] |= ( *codes >> 4) & 0xF;
-	  bytes[1] = ( *codes << 4) & 0xF0;
-	  ++codes;
-
-	  if (has_W_code)
-	    {
-	      bytes[1] |= 0x20;
-	    }
-	  if (has_F_code)
-	    {
-	      bytes[1] |= 0x40;
-	    }
-	
-	  // Rn
-	  bytes[1] |= regval (&ins->oprs[0],1);
-
-	  data = ins->oprs[1].basereg;
-
-	  bytes[2] = ((data >> 8) & 0xFF);
-	  bytes[3] = (data & 0xFF);
-	
-	  break;
-	
-        case 0x27:	// SWP Rd, Rm, [Rn]
-	  ++codes;
-	
-	  bytes[0] = c;
-
-	  bytes[0] |= *codes++;
-	
-	  bytes[1] = regval (&ins->oprs[2],1);
-	  if (has_B_code)
-	    {
-	      bytes[1] |= 0x40;
-	    }
-	  bytes[2] = regval (&ins->oprs[0],1) << 4;
-	  bytes[3] = *codes++;
-	  bytes[3] |= regval (&ins->oprs[1],1);
-	  break;
-	
-        default:
-	  errfunc (ERR_FATAL, "unknown decoding of instruction");
-
-	  bytes[0] = c;
-	  // And a fix nibble
-	  ++codes;
-	  bytes[0] |= *codes++;
-
-	 if ( *codes == 0x01)		// An I bit
-	   {
-
-	   }
-	 if ( *codes == 0x02)		// An I bit
-	   {
-
-	   }
-	 ++codes;
-      }
-    out (offset, segment, bytes, OUT_RAWDATA+4, NO_SEG, NO_SEG);
-}
-
-
-*)
-{$endif dummy
-}

compiler/compiler/arm/agarmgas.pas

@@ -1,237 +0,0 @@
-{
-    Copyright (c) 2003 by Florian Klaempfl
-
-    This unit implements an asm for the ARM
-
-    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 GNU Assembler writer for the ARM
-}
-
-unit agarmgas;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-       aasmtai,
-       aggas,
-       cpubase;
-
-    type
-      PARMGNUAssembler=^TARMGNUAssembler;
-      TARMGNUAssembler=class(TGNUassembler)
-        procedure WriteInstruction(hp : tai);override;
-      end;
-
-    const
-      gas_shiftmode2str : array[tshiftmode] of string[3] = (
-        '','lsl','lsr','asr','ror','rrx');
-
-  implementation
-
-    uses
-       cutils,globals,verbose,
-       systems,
-       assemble,
-       aasmcpu,
-       itcpugas,
-       cgbase,cgutils;
-
-    const
-       as_arm_gas_info : tasminfo =
-          (
-            id     : as_gas;
-
-            idtxt  : 'AS';
-            asmbin : 'as';
-            asmcmd : '-o $OBJ $ASM';
-            supported_target : system_any;
-            flags : [af_allowdirect,af_needar,af_smartlink_sections];
-            labelprefix : '.L';
-            comment : '# ';
-          );
-
-    function getreferencestring(var ref : treference) : string;
-      var
-        s : string;
-      begin
-         with ref do
-          begin
-{$ifdef extdebug}
-            // if base=NR_NO then
-            //   internalerror(200308292);
-
-            // if ((index<>NR_NO) or (shiftmode<>SM_None)) and ((offset<>0) or (symbol<>nil)) then
-            //   internalerror(200308293);
-{$endif extdebug}
-
-            if assigned(symbol) then
-              begin
-                if (base<>NR_NO) and not(is_pc(base)) then
-                  internalerror(200309011);
-                s:=symbol.name;
-                if offset<0 then
-                  s:=s+tostr(offset)
-                else if offset>0 then
-                  s:=s+'+'+tostr(offset);
-              end
-            else
-              begin
-                s:='['+gas_regname(base);
-                if addressmode=AM_POSTINDEXED then
-                  s:=s+']';
-                if index<>NR_NO then
-                  begin
-                     if signindex<0 then
-                       s:=s+', -'
-                     else
-                       s:=s+', ';
-
-                     s:=s+gas_regname(index);
-
-                     if shiftmode<>SM_None then
-                       s:=s+' ,'+gas_shiftmode2str[shiftmode]+' #'+tostr(shiftimm);
-                  end
-                else if offset<>0 then
-                  s:=s+', #'+tostr(offset);
-
-                case addressmode of
-                  AM_OFFSET:
-                    s:=s+']';
-                  AM_PREINDEXED:
-                    s:=s+']!';
-                end;
-              end;
-
-          end;
-        getreferencestring:=s;
-      end;
-
-
-    const
-      shiftmode2str: array[tshiftmode] of string[3] = ('','lsl','lsr','asr','ror','rrx');
-
-    function getopstr(const o:toper) : string;
-      var
-        hs : string;
-        first : boolean;
-        r : tsuperregister;
-      begin
-        case o.typ of
-          top_reg:
-            getopstr:=gas_regname(o.reg);
-          top_shifterop:
-            begin
-              if (o.shifterop^.rs<>NR_NO) and (o.shifterop^.shiftimm=0) then
-                getopstr:=shiftmode2str[o.shifterop^.shiftmode]+' '+gas_regname(o.shifterop^.rs)
-              else if (o.shifterop^.rs=NR_NO) then
-                getopstr:=shiftmode2str[o.shifterop^.shiftmode]+' #'+tostr(o.shifterop^.shiftimm)
-              else internalerror(200308282);
-            end;
-          top_const:
-            getopstr:='#'+tostr(longint(o.val));
-          top_regset:
-            begin
-              getopstr:='{';
-              first:=true;
-              for r:=RS_R0 to RS_R15 do
-                if r in o.regset^ then
-                  begin
-                    if not(first) then
-                      getopstr:=getopstr+',';
-                    getopstr:=getopstr+gas_regname(newreg(R_INTREGISTER,r,R_SUBWHOLE));
-                    first:=false;
-                  end;
-              getopstr:=getopstr+'}';
-            end;
-          top_ref:
-            if o.ref^.refaddr=addr_full then
-              begin
-                hs:=o.ref^.symbol.name;
-                if o.ref^.offset>0 then
-                 hs:=hs+'+'+tostr(o.ref^.offset)
-                else
-                 if o.ref^.offset<0 then
-                  hs:=hs+tostr(o.ref^.offset);
-                getopstr:=hs;
-              end
-            else
-              getopstr:=getreferencestring(o.ref^);
-          else
-            internalerror(2002070604);
-        end;
-      end;
-
-
-    Procedure TARMGNUAssembler.WriteInstruction(hp : tai);
-    var op: TAsmOp;
-        s: string;
-        i: byte;
-        sep: string[3];
-    begin
-      op:=taicpu(hp).opcode;
-      s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix];
-      if taicpu(hp).ops<>0 then
-        begin
-          sep:=#9;
-          for i:=0 to taicpu(hp).ops-1 do
-            begin
-               // debug code
-               // writeln(s);
-               // writeln(taicpu(hp).fileinfo.line);
-
-               { LDM and STM use references as first operand but they are written like a register }
-               if (i=0) and (op in [A_LDM,A_STM]) then
-                 begin
-                   case taicpu(hp).oper[0]^.typ of
-                     top_ref:
-                       begin
-                         s:=s+sep+gas_regname(taicpu(hp).oper[0]^.ref^.index);
-                         if taicpu(hp).oper[0]^.ref^.addressmode=AM_PREINDEXED then
-                           s:=s+'!';
-                       end;
-                     top_reg:
-                       s:=s+sep+gas_regname(taicpu(hp).oper[0]^.reg);
-                     else
-                       internalerror(200311292);
-                   end;
-                 end
-               { register count of SFM and LFM is written without # }
-               else if (i=1) and (op in [A_SFM,A_LFM]) then
-                 begin
-                   case taicpu(hp).oper[1]^.typ of
-                     top_const:
-                       s:=s+sep+tostr(taicpu(hp).oper[1]^.val);
-                     else
-                       internalerror(200311292);
-                   end;
-                 end
-               else
-                 s:=s+sep+getopstr(taicpu(hp).oper[i]^);
-
-               sep:=',';
-            end;
-        end;
-      AsmWriteLn(s);
-    end;
-
-
-begin
-  RegisterAssembler(as_arm_gas_info,TARMGNUAssembler);
-end.

compiler/compiler/arm/aoptcpu.pas

@@ -1,42 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal
-    Development Team
-
-    This unit implements the ARM 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;
-
-{$i fpcdefs.inc}
-
-Interface
-
-uses cpubase, aopt, aoptcpub;
-
-Type
-  TCpuAsmOptimizer = class(TAsmOptimizer)
-    { uses the same constructor as TAopObj }
-  End;
-
-Implementation
-
-begin
-  casmoptimizer:=TCpuAsmOptimizer;
-End.

compiler/compiler/arm/aoptcpub.pas

@@ -1,120 +0,0 @@
- {
-    Copyright (c) 1998-2002 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 ARM 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 }
-
-{$i fpcdefs.inc}
-
-{ enable the following define if memory references can have both a base and }
-{ index register in 1 operand                                               }
-
-{$define RefsHaveIndexReg}
-
-{ 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
-  cpubase,aasmcpu,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 = class(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;
-
-  aopt_uncondjmp = A_B;
-  aopt_condjmp = A_B;
-    
-Implementation
-
-{ ************************************************************************* }
-{ **************************** TCondRegs ********************************** }
-{ ************************************************************************* }
-Constructor TCondRegs.init;
-Begin
-End;
-
-Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
-Begin
-End;
-
-End.

compiler/compiler/arm/aoptcpuc.pas

@@ -1,38 +0,0 @@
- {
-    Copyright (c) 1998-2002 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/compiler/arm/aoptcpud.pas

@@ -1,40 +0,0 @@
-{
-    Copyright (c) 1998-2002 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;
-
-{$i fpcdefs.inc}
-
-Interface
-
-uses
-  AOptDA;
-
-Type
-  TAOptDFACpu = class(TAOptDFA)
-  End;
-
-Implementation
-
-
-End.

compiler/compiler/arm/armatt.inc

@@ -1,90 +0,0 @@
-{ don't edit, this file is generated from armins.dat }
-(
-'none',
-'abs',
-'acs',
-'asn',
-'atn',
-'adc',
-'add',
-'adf',
-'and',
-'b',
-'bic',
-'bl',
-'blx',
-'bkpt',
-'bx',
-'cdp',
-'cmf',
-'cmfe',
-'cmn',
-'cmp',
-'clz',
-'cnf',
-'cos',
-'dvf',
-'eor',
-'exp',
-'fdv',
-'flt',
-'fix',
-'fml',
-'frd',
-'ldc',
-'ldm',
-'ldrbt',
-'ldrb',
-'ldr',
-'ldrh',
-'ldrsb',
-'ldrsh',
-'ldrt',
-'ldf',
-'lfm',
-'lgn',
-'log',
-'mcr',
-'mla',
-'mov',
-'mnf',
-'muf',
-'mul',
-'mvf',
-'mvn',
-'orr',
-'rdf',
-'rfs',
-'rfc',
-'rmf',
-'rpw',
-'rsb',
-'rsc',
-'rsf',
-'rnd',
-'pol',
-'sbc',
-'sfm',
-'sin',
-'smlal',
-'smull',
-'sqt',
-'suf',
-'stf',
-'stm',
-'str',
-'strb',
-'strbt',
-'strh',
-'strt',
-'sub',
-'swi',
-'swp',
-'swpb',
-'tan',
-'teq',
-'tst',
-'umlal',
-'umull',
-'wfs'
-);

compiler/compiler/arm/armatts.inc

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

compiler/compiler/arm/armins.dat

@@ -1,394 +0,0 @@
-;
-; Table of assembler instructions for Free Pascal
-; adapted from Netwide Assembler by Florian Klaempfl
-;
-;
-; The Netwide Assembler is copyright (C) 1996 Simon Tatham and
-; Julian Hall. All rights reserved. The software is
-; redistributable under the licence given in the file "Licence"
-; distributed in the NASM archive.
-;
-; Format of file: all four fields must be present on every functional
-; line. Hence `void' for no-operand instructions, and `\0' for such
-; as EQU. If the last three fields are all `ignore', no action is
-; taken except to register the opcode as being present.
-;
-;
-; 'ignore' means no instruc
-; 'void'   means instruc with zero operands
-;
-; Third field has a first byte indicating how to
-; put together the bits, and then some codes
-; that may be used at will (see assemble.c)
-;
-; \1   - 24 bit pc-rel offset		[B, BL]
-; \2   - 24 bit imm value		[SWI]
-; \3   -  3 byte code			[BX]
-;
-; \4   - reg,reg,reg			[AND,EOR,SUB,RSB,ADD,ADC,SBC,RSC,ORR,BIC]
-; \5   - reg,reg,reg,<shift>reg		[-"-]
-; \6   - reg,reg,reg,<shift>#imm	[-"-]
-; \7   - reg,reg,#imm			[-"-]
-;
-; \x8  - reg,reg			[MOV,MVN]
-; \x9  - reg,reg,<shift>reg		[-"-]
-; \xA  - reg,reg,<shift>#imm		[-"-]
-; \xB  - reg,#imm			[-"-]
-;
-; \xC  - reg,reg			[CMP,CMN,TEQ,TST]
-; \xD  - reg,reg,<shift>reg		[-"-]
-; \xE  - reg,reg,<shift>#imm		[-"-]
-; \xF  - reg,#imm			[-"-]
-;
-; \xFx - floating point instructions
-;        Floating point instruction format information, taken from the linux kernel,
-;        for detailed tables, see aasmcpu.pas
-;
-;        ARM Floating Point Instruction Classes
-;        | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
-;        |c o n d|1 1 0 P|U|u|W|L|   Rn  |v|  Fd |0|0|0|1|  o f f s e t  | CPDT
-;        |c o n d|1 1 0 P|U|w|W|L|   Rn  |x|  Fd |0|0|1|0|  o f f s e t  | CPDT (copro 2)
-;        | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
-;        |c o n d|1 1 1 0|a|b|c|d|e|  Fn |j|  Fd |0|0|0|1|f|g|h|0|i|  Fm | CPDO
-;        |c o n d|1 1 1 0|a|b|c|L|e|  Fn |   Rd  |0|0|0|1|f|g|h|1|i|  Fm | CPRT
-;        |c o n d|1 1 1 0|a|b|c|1|e|  Fn |1|1|1|1|0|0|0|1|f|g|h|1|i|  Fm | comparisons
-;        | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
-;
-;        CPDT            data transfer instructions
-;                        LDF, STF, LFM (copro 2), SFM (copro 2)
-;
-;        CPDO            dyadic arithmetic instructions
-;                        ADF, MUF, SUF, RSF, DVF, RDF,
-;                        POW, RPW, RMF, FML, FDV, FRD, POL
-;
-;        CPDO            monadic arithmetic instructions
-;                        MVF, MNF, ABS, RND, SQT, LOG, LGN, EXP,
-;                        SIN, COS, TAN, ASN, ACS, ATN, URD, NRM
-;
-;        CPRT            joint arithmetic/data transfer instructions
-;                        FIX (arithmetic followed by load/store)
-;                        FLT (load/store followed by arithmetic)
-;                        CMF, CNF CMFE, CNFE (comparisons)
-;                        WFS, RFS (write/read floating point status register)
-;                        WFC, RFC (write/read floating point control register)
-; \xF0 - CPDT
-;        code 1: copro (1/2)
-;        code 2: load/store bit
-; \xF1 - CPDO
-; \xF2 - CPDO monadic
-; \xF3 - CPRT
-; \xF4 - CPRT comparison
-;
-; \xFF - fix me
-;
-
-[NONE]
-void                  void                            none
-
-[ABScc]
-
-[ACScc]
-
-[ASNcc]
-
-[ATNcc]
-
-[ADCcc]
-reg32,reg32,reg32        \4\x0\xA0                     ARM7
-reg32,reg32,reg32,reg32  \5\x0\xA0                     ARM7
-reg32,reg32,reg32,imm    \6\x0\xA0                     ARM7
-reg32,reg32,imm          \7\x2\xA0                     ARM7
-
-[ADDcc]
-reg32,reg32,reg32        \4\x0\x80                     ARM7
-reg32,reg32,reg32,reg32  \5\x0\x80                     ARM7
-reg32,reg32,reg32,imm    \6\x0\x80                     ARM7
-reg32,reg32,imm          \7\x2\x80                     ARM7
-
-[ADFcc]
-
-[ANDcc]
-reg32,reg32,reg32        \4\x0\x00                     ARM7
-reg32,reg32,reg32,reg32  \5\x0\x00                     ARM7
-reg32,reg32,reg32,imm    \6\x0\x00                     ARM7
-reg32,reg32,imm          \7\x2\x00                     ARM7
-
-[Bcc]
-mem32                    \1\x0A                        ARM7
-imm24                    \1\x0A                        ARM7
-
-[BICcc]
-reg32,reg32,reg32        \4\x1\xC0                     ARM7
-reg32,reg32,reg32,reg32  \5\x1\xC0                     ARM7
-reg32,reg32,reg32,imm    \6\x1\xC0                     ARM7
-reg32,reg32,imm          \7\x3\xC0                     ARM7
-
-[BLcc]
-mem32                    \1\x0B                        ARM7
-imm24                    \1\x0B                        ARM7
-
-[BLX]
-mem32                    \xff                        ARM7
-imm24                    \xff                        ARM7
-
-[BKPTcc]
-
-[BXcc]
-reg32                    \3\x01\x2F\xFF\x10            ARM7
-
-[CDP]
-reg8,reg8           \300\1\x10\101                ARM7
-
-[CMFcc]
-
-[CMFEcc]
-
-[CMNcc]
-reg32,reg32              \xC\x1\x60                     ARM7
-reg32,reg32,reg32        \xD\x1\x60                     ARM7
-reg32,reg32,imm          \xE\x1\x60                     ARM7
-reg32,imm                \xF\x3\x60                     ARM7
-
-[CMPcc]
-reg32,reg32              \xC\x1\x40                     ARM7
-reg32,reg32,reg32        \xD\x1\x40                     ARM7
-reg32,reg32,imm          \xE\x1\x40                     ARM7
-reg32,imm                \xF\x3\x40                     ARM7
-
-[CLZcc]
-reg32,reg32              \x27\x01\x01                   ARM7
-
-[CNFcc]
-
-[COScc]
-
-[DVFcc]
-
-[EORcc]
-reg32,reg32,reg32        \4\x0\x20                     ARM7
-reg32,reg32,reg32,reg32  \5\x0\x20                     ARM7
-reg32,reg32,reg32,imm    \6\x0\x20                     ARM7
-reg32,reg32,imm          \7\x2\x20                     ARM7
-
-[EXPcc]
-
-[FDVcc]
-
-[FLTcc]
-
-[FIXcc]
-
-[FMLcc]
-
-[FRDcc]
-
-[LDC]
-reg32,reg32         \321\300\1\x11\101            ARM7
-
-[LDMcc]
-memam4,reglist		   \x26\x81			ARM7
-
-[LDRBTcc]
-
-[LDRBcc]
-reg32,memam2              \x17\x07\x10                            ARM7
-
-[LDRcc]
-reg32,memam2              \x17\x05\x10                   ARM7
-; reg32,imm32              \x17\x05\x10                   ARM7
-; reg32,reg32              \x18\x04\x10                   ARM7
-; reg32,reg32,imm32        \x19\x04\x10                   ARM7
-; reg32,reg32,reg32        \x20\x06\x10                   ARM7
-; reg32,reg32,reg32,imm32  \x21\x06\x10                   ARM7
-
-[LDRHcc]
-reg32,imm32              \x22\x50\xB0               ARM7
-reg32,reg32              \x23\x50\xB0               ARM7
-reg32,reg32,imm32        \x24\x50\xB0                   ARM7
-reg32,reg32,reg32        \x25\x10\xB0                   ARM7
-
-[LDRSBcc]
-reg32,imm32              \x22\x50\xD0               ARM7
-reg32,reg32              \x23\x50\xD0               ARM7
-reg32,reg32,imm32        \x24\x50\xD0                   ARM7
-reg32,reg32,reg32        \x25\x10\xD0                   ARM7
-
-[LDRSHcc]
-reg32,imm32              \x22\x50\xF0               ARM7
-reg32,reg32              \x23\x50\xF0               ARM7
-reg32,reg32,imm32        \x24\x50\xF0                   ARM7
-reg32,reg32,reg32        \x25\x10\xF0                   ARM7
-
-[LDRTcc]
-
-[LDFcc]
-
-[LFMcc]
-reg32,imm8,fpureg        \xF0\x02\x01                   FPA
-
-[LGNcc]
-
-[LOGcc]
-
-[MCR]
-reg32,mem32         \320\301\1\x13\110            ARM7
-
-[MLAcc]
-reg32,reg32,reg32,reg32  \x15\x00\x20\x90               ARM7
-
-[MOVcc]
-reg32,shifterop              \x8\x0\0xd                   ARM7
-reg32,immshifter             \x8\x0\0xd                  ARM7
-; reg32,reg32,reg32        \x9\x1\xA0                     ARM7
-; reg32,reg32,imm          \xA\x1\xA0                     ARM7
-; reg32,imm                \xB\x3\xA0                     ARM7
-
-; [MRC]
-; reg32,reg32         \321\301\1\x13\110                  ARM7
-
-; [MRScc]
-; reg32,reg32         \x10\x01\x0F                        ARM7
-
-; [MSRcc]
-; reg32,reg32         \x11\x01\x29\xF0                    ARM7
-; regf,reg32          \x12\x01\x28\xF0                    ARM7
-; regf,imm            \x13\x03\x28\xF0                    ARM7
-
-[MNFcc]
-
-[MUFcc]
-
-[MULcc]
-reg32,reg32,reg32        \x14\x00\x00\x90          ARM7
-
-[MVFcc]
-fpureg,fpureg              \xF2                      FPA
-fpureg,immfpu              \xF2                      FPA
-
-[MVNcc]
-reg32,reg32         \x8\x0\0xf                     ARM7
-reg32,reg32,reg32   \x9\x1\xE0                     ARM7
-reg32,reg32,imm     \xA\x1\xE0                     ARM7
-reg32,imm           \xB\x3\xE0                     ARM7
-
-[ORRcc]
-reg32,reg32,reg32        \4\x1\x80                     ARM7
-reg32,reg32,reg32,reg32  \5\x1\x80                     ARM7
-reg32,reg32,reg32,imm    \6\x1\x80                     ARM7
-reg32,reg32,imm          \7\x3\x80                     ARM7
-
-[RDFcc]
-
-[RFScc]
-
-[RFCcc]
-
-[RMFcc]
-
-[RPWcc]
-
-[RSBcc]
-reg32,reg32,reg32        \4\x0\x60                     ARM7
-reg32,reg32,reg32,reg32  \5\x0\x60                     ARM7
-reg32,reg32,reg32,imm    \6\x0\x60                     ARM7
-reg32,reg32,imm          \7\x2\x60                     ARM7
-
-[RSCcc]
-reg32,reg32,reg32        \4\x0\xE0                     ARM7
-reg32,reg32,reg32,reg32  \5\x0\xE0                     ARM7
-reg32,reg32,reg32,imm    \6\x0\xE0                     ARM7
-reg32,reg32,imm          \7\x2\xE0                     ARM7
-
-[RSFcc]
-
-[RNDcc]
-
-[POLcc]
-
-[SBCcc]
-reg32,reg32,reg32        \4\x0\xC0                     ARM7
-reg32,reg32,reg32,reg32  \5\x0\xC0                     ARM7
-reg32,reg32,reg32,imm    \6\x0\xC0                     ARM7
-reg32,reg32,imm          \7\x2\xC0                     ARM7
-
-[SFMcc]
-reg32,imm8,fpureg        \xF0\x02\x00                   FPA
-
-[SINcc]
-
-[SMLALcc]
-reg32,reg32,reg32,reg32  \x16\x00\xE0\x90		 ARM7
-
-[SMULLcc]
-reg32,reg32,reg32,reg32  \x16\x00\xC0\x90		 ARM7
-
-[SQTcc]
-
-[SUFcc]
-
-[STFcc]
-
-[STMcc]
-memam4,reglist		   \x26\x80			ARM7
-
-[STRcc]
-reg32,memam2              \x17\x04\x00                   ARM7
-; reg32,imm32              \x17\x05\x00                   ARM7
-; reg32,reg32              \x18\x04\x00                   ARM7
-; reg32,reg32,imm32        \x19\x04\x00                   ARM7
-; reg32,reg32,reg32        \x20\x06\x00                   ARM7
-; reg32,reg32,reg32,imm32  \x21\x06\x00                   ARM7
-
-[STRBcc]
-reg32,memam2              \x17\x06\x00                           ARM7
-
-[STRBTcc]
-
-; A dummy since it is parsed as STR{cond}H
-[STRHcc]
-reg32,imm32              \x22\x40\xB0              ARM7
-reg32,reg32              \x23\x40\xB0               ARM7
-reg32,reg32,imm32        \x24\x40\xB0                   ARM7
-reg32,reg32,reg32        \x25\x00\xB0                   ARM7
-
-[STRTcc]
-
-[SUBcc]
-reg32,reg32,shifterop     \4\x0\x40                     ARM7
-reg32,reg32,immshifter    \4\x0\x40                     ARM7
-reg32,reg32,reg32        \4\x0\x40                     ARM7
-; reg32,reg32,reg32,reg32  \5\x0\x40                     ARM7
-; reg32,reg32,reg32,imm    \6\x0\x40                     ARM7
-; reg32,reg32,imm          \7\x2\x40                     ARM7
-
-[SWIcc]
-imm                 \2\x0F                        ARM7
-
-[SWPcc]
-reg32,reg32,reg32   \x27\x01\x90                   ARM7
-
-[SWPBcc]
-reg32,reg32,reg32   \x27\x01\x90                   ARM7
-
-[TANcc]
-
-[TEQcc]
-reg32,reg32         \xC\x1\x20                     ARM7
-reg32,reg32,reg32   \xD\x1\x20                     ARM7
-reg32,reg32,imm     \xE\x1\x20                     ARM7
-reg32,imm           \xF\x3\x20                     ARM7
-
-[TSTcc]
-reg32,reg32         \xC\x1\x00                     ARM7
-reg32,reg32,reg32   \xD\x1\x00                     ARM7
-reg32,reg32,imm     \xE\x1\x00                     ARM7
-reg32,imm           \xF\x3\x00                     ARM7
-
-[UMLALcc]
-reg32,reg32,reg32,reg32  \x16\x00\xA0\x90		 ARM7
-
-[UMULLcc]
-reg32,reg32,reg32,reg32  \x16\x00\x80\x90		 ARM7
-
-[WFScc]
-

compiler/compiler/arm/armnop.inc

@@ -1,2 +0,0 @@
-{ don't edit, this file is generated from armins.dat }
-108;

compiler/compiler/arm/armop.inc

@@ -1,90 +0,0 @@
-{ don't edit, this file is generated from armins.dat }
-(
-A_NONE,
-A_ABS,
-A_ACS,
-A_ASN,
-A_ATN,
-A_ADC,
-A_ADD,
-A_ADF,
-A_AND,
-A_B,
-A_BIC,
-A_BL,
-A_BLX,
-A_BKPT,
-A_BX,
-A_CDP,
-A_CMF,
-A_CMFE,
-A_CMN,
-A_CMP,
-A_CLZ,
-A_CNF,
-A_COS,
-A_DVF,
-A_EOR,
-A_EXP,
-A_FDV,
-A_FLT,
-A_FIX,
-A_FML,
-A_FRD,
-A_LDC,
-A_LDM,
-A_LDRBT,
-A_LDRB,
-A_LDR,
-A_LDRH,
-A_LDRSB,
-A_LDRSH,
-A_LDRT,
-A_LDF,
-A_LFM,
-A_LGN,
-A_LOG,
-A_MCR,
-A_MLA,
-A_MOV,
-A_MNF,
-A_MUF,
-A_MUL,
-A_MVF,
-A_MVN,
-A_ORR,
-A_RDF,
-A_RFS,
-A_RFC,
-A_RMF,
-A_RPW,
-A_RSB,
-A_RSC,
-A_RSF,
-A_RND,
-A_POL,
-A_SBC,
-A_SFM,
-A_SIN,
-A_SMLAL,
-A_SMULL,
-A_SQT,
-A_SUF,
-A_STF,
-A_STM,
-A_STR,
-A_STRB,
-A_STRBT,
-A_STRH,
-A_STRT,
-A_SUB,
-A_SWI,
-A_SWP,
-A_SWPB,
-A_TAN,
-A_TEQ,
-A_TST,
-A_UMLAL,
-A_UMULL,
-A_WFS
-);

compiler/compiler/arm/armreg.dat

@@ -1,84 +0,0 @@
-;
-; ARM registers
-;
-; layout
-; <name>,<type>,<value>,<stdname>,<stab idx>,<dwarf idx>
-;
-NO,$00,$00,INVALID,-1,-1
-; Integer registers
-R0,$01,$00,r0,0,0
-R1,$01,$01,r1,1,1
-R2,$01,$02,r2,2,2
-R3,$01,$03,r3,3,3
-R4,$01,$04,r4,4,4
-R5,$01,$05,r5,5,5
-R6,$01,$06,r6,6,6
-R7,$01,$07,r7,7,7
-R8,$01,$08,r8,8,8
-R9,$01,$09,r9,9,9
-R10,$01,$0a,r10,10,10
-R11,$01,$0b,r11,11,11
-R12,$01,$0c,r12,12,12
-R13,$01,$0d,r13,13,13
-R14,$01,$0e,r14,14,14
-R15,$01,$0f,r15,15,15
-
-; Float registers
-F0,$02,$00,f0,32,16
-F1,$02,$01,f1,32,17
-F2,$02,$02,f2,32,18
-F3,$02,$03,f3,32,19
-F4,$02,$04,f4,32,20
-F5,$02,$05,f5,32,21
-F6,$02,$06,f6,32,22
-F7,$02,$07,f7,32,23
-
-; MM registers
-S0,$03,$00,s0,0,0
-S1,$03,$00,s1,0,0
-D0,$03,$00,d0,0,0
-S2,$03,$00,s2,0,0
-S3,$03,$00,s3,0,0
-D1,$03,$00,d1,0,0
-S4,$03,$00,s4,0,0
-S5,$03,$00,s5,0,0
-D2,$03,$00,d2,0,0
-S6,$03,$00,s6,0,0
-S7,$03,$00,s7,0,0
-D3,$03,$00,d3,0,0
-S8,$03,$00,s8,0,0
-S9,$03,$00,s9,0,0
-D4,$03,$00,d4,0,0
-S10,$03,$00,s10,0,0
-S11,$03,$00,s11,0,0
-D5,$03,$00,d5,0,0
-S12,$03,$00,s12,0,0
-S13,$03,$00,s13,0,0
-D6,$03,$00,d6,0,0
-S14,$03,$00,s14,0,0
-S15,$03,$00,s15,0,0
-D7,$03,$00,d7,0,0
-S16,$03,$00,s16,0,0
-S17,$03,$00,s17,0,0
-D8,$03,$00,d8,0,0
-S18,$03,$00,s18,0,0
-S19,$03,$00,s19,0,0
-D9,$03,$00,d9,0,0
-S20,$03,$00,s20,0,0
-S21,$03,$00,s21,0,0
-D10,$03,$00,d10,0,0
-S22,$03,$00,s22,0,0
-S23,$03,$00,s23,0,0
-D11,$03,$00,d11,0,0
-S24,$03,$00,s24,0,0
-S25,$03,$00,s25,0,0
-D12,$03,$00,d12,0,0
-S26,$03,$00,s26,0,0
-S27,$03,$00,s27,0,0
-D13,$03,$00,d13,0,0
-S28,$03,$00,s28,0,0
-S29,$03,$00,s29,0,0
-D14,$03,$00,d14,0,0
-S30,$03,$00,s20,0,0
-S31,$03,$00,s21,0,0
-D15,$03,$00,d15,0,0

compiler/compiler/arm/armtab.inc

@@ -1,759 +0,0 @@
-{ don't edit, this file is generated from armins.dat }
-(
-  (
-    opcode  : A_NONE;
-    ops     : 0;
-    optypes : (ot_none,ot_none,ot_none,ot_none);
-    code    : #0;
-    flags   : if_none
-  ),
-  (
-    opcode  : A_ADC;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#0#160;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ADC;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #5#0#160;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ADC;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate);
-    code    : #6#0#160;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ADC;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #7#2#160;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ADD;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#0#128;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ADD;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #5#0#128;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ADD;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate);
-    code    : #6#0#128;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ADD;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #7#2#128;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_AND;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#0#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_AND;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #5#0#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_AND;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate);
-    code    : #6#0#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_AND;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #7#2#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_B;
-    ops     : 1;
-    optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none);
-    code    : #1#10;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_B;
-    ops     : 1;
-    optypes : (ot_immediate24,ot_none,ot_none,ot_none);
-    code    : #1#10;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_BIC;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#1#192;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_BIC;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #5#1#192;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_BIC;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate);
-    code    : #6#1#192;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_BIC;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #7#3#192;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_BL;
-    ops     : 1;
-    optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none);
-    code    : #1#11;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_BL;
-    ops     : 1;
-    optypes : (ot_immediate24,ot_none,ot_none,ot_none);
-    code    : #1#11;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_BLX;
-    ops     : 1;
-    optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none);
-    code    : #15#15;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_BLX;
-    ops     : 1;
-    optypes : (ot_immediate24,ot_none,ot_none,ot_none);
-    code    : #15#15;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_BX;
-    ops     : 1;
-    optypes : (ot_reg32,ot_none,ot_none,ot_none);
-    code    : #3#1#47#255#16;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CDP;
-    ops     : 2;
-    optypes : (ot_reg8,ot_reg8,ot_none,ot_none);
-    code    : #192#1#16#65;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CMN;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #12#1#96;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CMN;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #13#1#96;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CMN;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #14#1#96;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CMN;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
-    code    : #15#3#96;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CMP;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #12#1#64;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CMP;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #13#1#64;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CMP;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #14#1#64;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CMP;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
-    code    : #15#3#64;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_CLZ;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #39#1#1;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_EOR;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#0#32;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_EOR;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #5#0#32;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_EOR;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate);
-    code    : #6#0#32;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_EOR;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #7#2#32;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDC;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #209#192#1#17#65;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDM;
-    ops     : 2;
-    optypes : (ot_memoryam4,ot_reglist,ot_none,ot_none);
-    code    : #38#129;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRB;
-    ops     : 2;
-    optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none);
-    code    : #23#7#16;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDR;
-    ops     : 2;
-    optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none);
-    code    : #23#5#16;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRH;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none);
-    code    : #34#80#176;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRH;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #35#80#176;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRH;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none);
-    code    : #36#80#176;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRH;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #37#16#176;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRSB;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none);
-    code    : #34#80#208;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRSB;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #35#80#208;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRSB;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none);
-    code    : #36#80#208;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRSB;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #37#16#208;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRSH;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none);
-    code    : #34#80#240;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRSH;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #35#80#240;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRSH;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none);
-    code    : #36#80#240;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LDRSH;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #37#16#240;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_LFM;
-    ops     : 3;
-    optypes : (ot_reg32,ot_immediate or ot_bits8,ot_fpureg,ot_none);
-    code    : #240#2#1;
-    flags   : if_fpa
-  ),
-  (
-    opcode  : A_MCR;
-    ops     : 2;
-    optypes : (ot_reg32,ot_memory or ot_bits32,ot_none,ot_none);
-    code    : #208#193#1#19#72;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_MLA;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #21#0#32#144;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_MOV;
-    ops     : 2;
-    optypes : (ot_reg32,ot_shifterop,ot_none,ot_none);
-    code    : #8#1#160;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_MOV;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediateshifter,ot_none,ot_none);
-    code    : #8#1#160;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_MUL;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #20#0#0#144;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_MVF;
-    ops     : 2;
-    optypes : (ot_fpureg,ot_fpureg,ot_none,ot_none);
-    code    : #242;
-    flags   : if_fpa
-  ),
-  (
-    opcode  : A_MVF;
-    ops     : 2;
-    optypes : (ot_fpureg,ot_immediatefpu,ot_none,ot_none);
-    code    : #242;
-    flags   : if_fpa
-  ),
-  (
-    opcode  : A_MVN;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #8#1#224;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_MVN;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #9#1#224;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_MVN;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #10#1#224;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_MVN;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
-    code    : #11#3#224;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ORR;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#1#128;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ORR;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #5#1#128;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ORR;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate);
-    code    : #6#1#128;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_ORR;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #7#3#128;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_RSB;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#0#96;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_RSB;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #5#0#96;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_RSB;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate);
-    code    : #6#0#96;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_RSB;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #7#2#96;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_RSC;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#0#224;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_RSC;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #5#0#224;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_RSC;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate);
-    code    : #6#0#224;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_RSC;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #7#2#224;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SBC;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#0#192;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SBC;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #5#0#192;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SBC;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_immediate);
-    code    : #6#0#192;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SBC;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #7#2#192;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SFM;
-    ops     : 3;
-    optypes : (ot_reg32,ot_immediate or ot_bits8,ot_fpureg,ot_none);
-    code    : #240#2#0;
-    flags   : if_fpa
-  ),
-  (
-    opcode  : A_SMLAL;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #22#0#224#144;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SMULL;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #22#0#192#144;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_STM;
-    ops     : 2;
-    optypes : (ot_memoryam4,ot_reglist,ot_none,ot_none);
-    code    : #38#128;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_STR;
-    ops     : 2;
-    optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none);
-    code    : #23#4#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_STRB;
-    ops     : 2;
-    optypes : (ot_reg32,ot_memoryam2,ot_none,ot_none);
-    code    : #23#6#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_STRH;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediate or ot_bits32,ot_none,ot_none);
-    code    : #34#64#176;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_STRH;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #35#64#176;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_STRH;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate or ot_bits32,ot_none);
-    code    : #36#64#176;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_STRH;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #37#0#176;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SUB;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_shifterop,ot_none);
-    code    : #4#0#64;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SUB;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediateshifter,ot_none);
-    code    : #4#0#64;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SUB;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #4#0#64;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SWI;
-    ops     : 1;
-    optypes : (ot_immediate,ot_none,ot_none,ot_none);
-    code    : #2#15;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SWP;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #39#1#144;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_SWPB;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #39#1#144;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_TEQ;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #12#1#32;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_TEQ;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #13#1#32;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_TEQ;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #14#1#32;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_TEQ;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
-    code    : #15#3#32;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_TST;
-    ops     : 2;
-    optypes : (ot_reg32,ot_reg32,ot_none,ot_none);
-    code    : #12#1#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_TST;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_none);
-    code    : #13#1#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_TST;
-    ops     : 3;
-    optypes : (ot_reg32,ot_reg32,ot_immediate,ot_none);
-    code    : #14#1#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_TST;
-    ops     : 2;
-    optypes : (ot_reg32,ot_immediate,ot_none,ot_none);
-    code    : #15#3#0;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_UMLAL;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #22#0#160#144;
-    flags   : if_arm7
-  ),
-  (
-    opcode  : A_UMULL;
-    ops     : 4;
-    optypes : (ot_reg32,ot_reg32,ot_reg32,ot_reg32);
-    code    : #22#0#128#144;
-    flags   : if_arm7
-  )
-);

compiler/compiler/arm/cgcpu.pas

@@ -1,1712 +0,0 @@
-{
-
-    Copyright (c) 2003 by Florian Klaempfl
-    Member of the Free Pascal development team
-
-    This unit implements the code generator for the ARM
-
-    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 cgcpu;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-       globtype,symtype,symdef,
-       cgbase,cgutils,cgobj,
-       aasmbase,aasmcpu,aasmtai,
-       parabase,
-       cpubase,cpuinfo,node,cg64f32,rgcpu;
-
-
-    type
-      tcgarm = class(tcg)
-        { true, if the next arithmetic operation should modify the flags }
-        cgsetflags : boolean;
-        procedure init_register_allocators;override;
-        procedure done_register_allocators;override;
-
-        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : TCGPara);override;
-        procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
-        procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara);override;
-
-        procedure a_call_name(list : taasmoutput;const s : string);override;
-        procedure a_call_reg(list : taasmoutput;reg: tregister); override;
-
-        procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override;
-        procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
-
-        procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
-          size: tcgsize; a: aint; src, dst: tregister); override;
-        procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
-          size: tcgsize; src1, src2, dst: tregister); override;
-        procedure a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
-        procedure a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override;
-
-        { move instructions }
-        procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aint;reg : tregister);override;
-        procedure a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
-        procedure a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
-        procedure a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
-
-        { fpu move instructions }
-        procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override;
-        procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
-        procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
-
-        procedure a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const paraloc : TCGPara);override;
-        {  comparison operations }
-        procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
-          l : tasmlabel);override;
-        procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
-
-        procedure a_jmp_name(list : taasmoutput;const s : string); override;
-        procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
-        procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
-
-        procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
-
-        procedure g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);override;
-        procedure g_proc_exit(list : taasmoutput;parasize : longint;nostackframe:boolean); override;
-
-        procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
-
-        procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint);override;
-        procedure g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint);override;
-        procedure g_concatcopy_move(list : taasmoutput;const source,dest : treference;len : aint);
-        procedure g_concatcopy_internal(list : taasmoutput;const source,dest : treference;len : aint;aligned : boolean);
-
-        procedure g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef); override;
-        procedure g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);override;
-
-        procedure g_save_standard_registers(list : taasmoutput);override;
-        procedure g_restore_standard_registers(list : taasmoutput);override;
-
-        procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
-        procedure fixref(list : taasmoutput;var ref : treference);
-        procedure handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
-
-        procedure g_intf_wrapper(list: taasmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);override;
-      end;
-
-      tcg64farm = class(tcg64f32)
-        procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override;
-        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override;
-        procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override;
-        procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override;
-        procedure a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
-        procedure a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
-      end;
-
-    const
-      OpCmp2AsmCond : Array[topcmp] of TAsmCond = (C_NONE,C_EQ,C_GT,
-                           C_LT,C_GE,C_LE,C_NE,C_LS,C_CC,C_CS,C_HI);
-
-    function get_fpu_postfix(def : tdef) : toppostfix;
-
-  implementation
-
-
-    uses
-       globals,verbose,systems,cutils,
-       fmodule,
-       symconst,symsym,
-       tgobj,
-       procinfo,cpupi,
-       paramgr;
-
-
-    function get_fpu_postfix(def : tdef) : toppostfix;
-      begin
-        if def.deftype=floatdef then
-          begin
-            case tfloatdef(def).typ of
-              s32real:
-                result:=PF_S;
-              s64real:
-                result:=PF_D;
-              s80real:
-                result:=PF_E;
-              else
-                internalerror(200401272);
-            end;
-          end
-        else
-          internalerror(200401271);
-      end;
-
-
-    procedure tcgarm.init_register_allocators;
-      begin
-        inherited init_register_allocators;
-        { currently, we save R14 always, so we can use it }
-        rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE,
-            [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
-             RS_R9,RS_R10,RS_R12,RS_R14],first_int_imreg,[]);
-        rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
-            [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
-        rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
-            [RS_S0,RS_S1,RS_R2,RS_R3,RS_R4,RS_S31],first_mm_imreg,[]);
-      end;
-
-
-    procedure tcgarm.done_register_allocators;
-      begin
-        rg[R_INTREGISTER].free;
-        rg[R_FPUREGISTER].free;
-        rg[R_MMREGISTER].free;
-        inherited done_register_allocators;
-      end;
-
-
-    procedure tcgarm.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const paraloc : TCGPara);
-      var
-        ref: treference;
-      begin
-        paraloc.check_simple_location;
-        case paraloc.location^.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load_const_reg(list,size,a,paraloc.location^.register);
-          LOC_REFERENCE:
-            begin
-               reference_reset(ref);
-               ref.base:=paraloc.location^.reference.index;
-               ref.offset:=paraloc.location^.reference.offset;
-               a_load_const_ref(list,size,a,ref);
-            end;
-          else
-            internalerror(2002081101);
-        end;
-      end;
-
-
-    procedure tcgarm.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const paraloc : TCGPara);
-      var
-        tmpref, ref: treference;
-        location: pcgparalocation;
-        sizeleft: aint;
-      begin
-        location := paraloc.location;
-        tmpref := r;
-        sizeleft := paraloc.intsize;
-        while assigned(location) do
-          begin
-            case location^.loc of
-              LOC_REGISTER,LOC_CREGISTER:
-                a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register);
-              LOC_REFERENCE:
-                begin
-                   reference_reset_base(ref,location^.reference.index,location^.reference.offset);
-                   g_concatcopy(list,tmpref,ref,sizeleft);
-                   if assigned(location^.next) then
-                     internalerror(2005010710);
-                end;
-              LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                case location^.size of
-                   OS_F32, OS_F64:
-                     a_loadfpu_ref_reg(list,location^.size,tmpref,location^.register);
-                   else
-                     internalerror(2002072801);
-                end;
-              LOC_VOID:
-                begin
-                  // nothing to do
-                end;
-              else
-                internalerror(2002081103);
-            end;
-            inc(tmpref.offset,tcgsize2size[location^.size]);
-            dec(sizeleft,tcgsize2size[location^.size]);
-            location := location^.next;
-          end;
-      end;
-
-
-    procedure tcgarm.a_paramaddr_ref(list : taasmoutput;const r : treference;const paraloc : TCGPara);
-      var
-        ref: treference;
-        tmpreg: tregister;
-      begin
-        paraloc.check_simple_location;
-        case paraloc.location^.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_loadaddr_ref_reg(list,r,paraloc.location^.register);
-          LOC_REFERENCE:
-            begin
-              reference_reset(ref);
-              ref.base := paraloc.location^.reference.index;
-              ref.offset := paraloc.location^.reference.offset;
-              tmpreg := getintregister(list,OS_ADDR);
-              a_loadaddr_ref_reg(list,r,tmpreg);
-              a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
-            end;
-          else
-            internalerror(2002080701);
-        end;
-      end;
-
-
-    procedure tcgarm.a_call_name(list : taasmoutput;const s : string);
-      begin
-        list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)));
-{
-        the compiler does not properly set this flag anymore in pass 1, and
-        for now we only need it after pass 2 (I hope) (JM)
-          if not(pi_do_call in current_procinfo.flags) then
-            internalerror(2003060703);
-}
-        include(current_procinfo.flags,pi_do_call);
-      end;
-
-
-    procedure tcgarm.a_call_reg(list : taasmoutput;reg: tregister);
-      var
-         r : tregister;
-      begin
-        list.concat(taicpu.op_reg_reg(A_MOV,NR_R14,NR_PC));
-        list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,reg));
-{
-        the compiler does not properly set this flag anymore in pass 1, and
-        for now we only need it after pass 2 (I hope) (JM)
-          if not(pi_do_call in current_procinfo.flags) then
-            internalerror(2003060703);
-}
-        include(current_procinfo.flags,pi_do_call);
-      end;
-
-
-     procedure tcgarm.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister);
-       begin
-          a_op_const_reg_reg(list,op,size,a,reg,reg);
-       end;
-
-
-     procedure tcgarm.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
-       begin
-         case op of
-           OP_NEG:
-             list.concat(taicpu.op_reg_reg_const(A_RSB,dst,src,0));
-           OP_NOT:
-             begin
-               list.concat(taicpu.op_reg_reg(A_MVN,dst,src));
-               case size of
-                 OS_8 :
-                   a_op_const_reg_reg(list,OP_AND,OS_INT,$ff,dst,dst);
-                 OS_16 :
-                   a_op_const_reg_reg(list,OP_AND,OS_INT,$ffff,dst,dst);
-               end;
-             end
-           else
-             a_op_reg_reg_reg(list,op,OS_32,src,dst,dst);
-         end;
-       end;
-
-
-    const
-      op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
-        (A_NONE,A_ADD,A_AND,A_NONE,A_NONE,A_MUL,A_MUL,A_NONE,A_NONE,A_ORR,
-         A_NONE,A_NONE,A_NONE,A_SUB,A_EOR);
-
-
-    procedure tcgarm.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
-      size: tcgsize; a: aint; src, dst: tregister);
-      var
-        ovloc : tlocation;
-      begin
-        a_op_const_reg_reg_checkoverflow(list,op,size,a,src,dst,false,ovloc);
-      end;
-
-
-    procedure tcgarm.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
-      size: tcgsize; src1, src2, dst: tregister);
-      var
-        ovloc : tlocation;
-      begin
-        a_op_reg_reg_reg_checkoverflow(list,op,size,src1,src2,dst,false,ovloc);
-      end;
-
-
-    procedure tcgarm.a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);
-      var
-        shift : byte;
-        tmpreg : tregister;
-        so : tshifterop;
-        l1 : longint;
-      begin
-        ovloc.loc:=LOC_VOID;
-        if is_shifter_const(-a,shift) then
-          case op of
-            OP_ADD:
-              begin
-                op:=OP_SUB;
-                a:=dword(-a);
-              end;
-            OP_SUB:
-              begin
-                op:=OP_ADD;
-                a:=dword(-a);
-              end
-          end;
-
-        if is_shifter_const(a,shift) and not(op in [OP_IMUL,OP_MUL]) then
-          case op of
-            OP_NEG,OP_NOT,
-            OP_DIV,OP_IDIV:
-              internalerror(200308281);
-            OP_SHL:
-              begin
-                if a>32 then
-                  internalerror(200308291);
-                if a<>0 then
-                  begin
-                    shifterop_reset(so);
-                    so.shiftmode:=SM_LSL;
-                    so.shiftimm:=a;
-                    list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
-                  end
-                else
-                 list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
-              end;
-            OP_SHR:
-              begin
-                if a>32 then
-                  internalerror(200308292);
-                shifterop_reset(so);
-                if a<>0 then
-                  begin
-                    so.shiftmode:=SM_LSR;
-                    so.shiftimm:=a;
-                    list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
-                  end
-                else
-                 list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
-              end;
-            OP_SAR:
-              begin
-                if a>32 then
-                  internalerror(200308291);
-                if a<>0 then
-                  begin
-                    shifterop_reset(so);
-                    so.shiftmode:=SM_ASR;
-                    so.shiftimm:=a;
-                    list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
-                  end
-                else
-                 list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
-              end;
-            else
-              list.concat(setoppostfix(
-                  taicpu.op_reg_reg_const(op_reg_reg_opcg2asmop[op],dst,src,a),toppostfix(ord(cgsetflags or setflags)*ord(PF_S))
-              ));
-              if (cgsetflags or setflags) and (size in [OS_8,OS_16,OS_32]) then
-                begin
-                  ovloc.loc:=LOC_FLAGS;
-                  case op of
-                    OP_ADD:
-                      ovloc.resflags:=F_CS;
-                    OP_SUB:
-                      ovloc.resflags:=F_CC;
-                  end;
-                end;
-          end
-        else
-          begin
-            { there could be added some more sophisticated optimizations }
-            if (op in [OP_MUL,OP_IMUL]) and (a=1) then
-              a_load_reg_reg(list,size,size,src,dst)
-            else if (op in [OP_MUL,OP_IMUL]) and (a=0) then
-              a_load_const_reg(list,size,0,dst)
-            else if (op in [OP_IMUL]) and (a=-1) then
-              a_op_reg_reg(list,OP_NEG,size,src,dst)
-            { we do this here instead in the peephole optimizer because
-              it saves us a register }
-            else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a,l1) and not(cgsetflags or setflags) then
-              a_op_const_reg_reg(list,OP_SHL,size,l1,src,dst)
-            else
-              begin
-                tmpreg:=getintregister(list,size);
-                a_load_const_reg(list,size,a,tmpreg);
-                a_op_reg_reg_reg_checkoverflow(list,op,size,tmpreg,src,dst,setflags,ovloc);
-              end;
-          end;
-      end;
-
-
-    procedure tcgarm.a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);
-      var
-        so : tshifterop;
-        tmpreg,overflowreg : tregister;
-        asmop : tasmop;
-      begin
-        ovloc.loc:=LOC_VOID;
-        case op of
-          OP_NEG,OP_NOT,
-          OP_DIV,OP_IDIV:
-            internalerror(200308281);
-          OP_SHL:
-            begin
-              shifterop_reset(so);
-              so.rs:=src1;
-              so.shiftmode:=SM_LSL;
-              list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
-            end;
-          OP_SHR:
-            begin
-              shifterop_reset(so);
-              so.rs:=src1;
-              so.shiftmode:=SM_LSR;
-              list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
-            end;
-          OP_SAR:
-            begin
-              shifterop_reset(so);
-              so.rs:=src1;
-              so.shiftmode:=SM_ASR;
-              list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
-            end;
-          OP_IMUL,
-          OP_MUL:
-            begin
-              if cgsetflags or setflags then
-                begin
-                  overflowreg:=getintregister(list,size);
-                  if op=OP_IMUL then
-                    asmop:=A_SMULL
-                  else
-                    asmop:=A_UMULL;
-                  { the arm doesn't allow that rd and rm are the same }
-                  if dst=src2 then
-                    begin
-                      if dst<>src1 then
-                        list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src1,src2))
-                      else
-                        begin
-                          tmpreg:=getintregister(list,size);
-                          a_load_reg_reg(list,size,size,src2,dst);
-                          list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,tmpreg,src1));
-                        end;
-                    end
-                  else
-                    list.concat(taicpu.op_reg_reg_reg_reg(asmop,dst,overflowreg,src2,src1));
-                  if op=OP_IMUL then
-                    begin
-                      shifterop_reset(so);
-                      so.shiftmode:=SM_ASR;
-                      so.shiftimm:=31;
-                      list.concat(taicpu.op_reg_reg_shifterop(A_CMP,overflowreg,dst,so));
-                    end
-                  else
-                    list.concat(taicpu.op_reg_const(A_CMP,overflowreg,0));
-
-                   ovloc.loc:=LOC_FLAGS;
-                   ovloc.resflags:=F_NE;
-                end
-              else
-                begin
-                  { the arm doesn't allow that rd and rm are the same }
-                  if dst=src2 then
-                    begin
-                      if dst<>src1 then
-                        list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src1,src2))
-                      else
-                        begin
-                          tmpreg:=getintregister(list,size);
-                          a_load_reg_reg(list,size,size,src2,dst);
-                          list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,tmpreg,src1));
-                        end;
-                    end
-                  else
-                    list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1));
-                end;
-            end;
-          else
-            list.concat(setoppostfix(
-                taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1),toppostfix(ord(cgsetflags or setflags)*ord(PF_S))
-              ));
-        end;
-      end;
-
-
-     procedure tcgarm.a_load_const_reg(list : taasmoutput; size: tcgsize; a : aint;reg : tregister);
-       var
-          imm_shift : byte;
-          l : tasmlabel;
-          hr : treference;
-       begin
-          if not(size in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then
-            internalerror(2002090902);
-          if is_shifter_const(a,imm_shift) then
-            list.concat(taicpu.op_reg_const(A_MOV,reg,a))
-          else if is_shifter_const(not(a),imm_shift) then
-            list.concat(taicpu.op_reg_const(A_MVN,reg,not(a)))
-          else
-            begin
-               reference_reset(hr);
-
-               objectlibrary.getjumplabel(l);
-               cg.a_label(current_procinfo.aktlocaldata,l);
-               hr.symboldata:=current_procinfo.aktlocaldata.last;
-               current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(longint(a)));
-
-               hr.symbol:=l;
-               list.concat(taicpu.op_reg_ref(A_LDR,reg,hr));
-            end;
-       end;
-
-
-    procedure tcgarm.handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
-      var
-        tmpreg : tregister;
-        tmpref : treference;
-        l : tasmlabel;
-      begin
-        tmpreg:=NR_NO;
-
-        { Be sure to have a base register }
-        if (ref.base=NR_NO) then
-          begin
-            if ref.shiftmode<>SM_None then
-              internalerror(200308294);
-            ref.base:=ref.index;
-            ref.index:=NR_NO;
-          end;
-
-        { absolute symbols can't be handled directly, we've to store the symbol reference
-          in the text segment and access it pc relative
-
-          For now, we assume that references where base or index equals to PC are already
-          relative, all other references are assumed to be absolute and thus they need
-          to be handled extra.
-
-          A proper solution would be to change refoptions to a set and store the information
-          if the symbol is absolute or relative there.
-        }
-
-        if (assigned(ref.symbol) and
-            not(is_pc(ref.base)) and
-            not(is_pc(ref.index))
-           ) or
-           { [#xxx] isn't a valid address operand }
-           ((ref.base=NR_NO) and (ref.index=NR_NO)) or
-           (ref.offset<-4095) or
-           (ref.offset>4095) or
-           ((oppostfix in [PF_SB,PF_H,PF_SH]) and
-            ((ref.offset<-255) or
-             (ref.offset>255)
-            )
-           ) or
-           ((op in [A_LDF,A_STF]) and
-            ((ref.offset<-1020) or
-             (ref.offset>1020)
-            )
-           ) then
-          begin
-            reference_reset(tmpref);
-
-            { load symbol }
-            tmpreg:=getintregister(list,OS_INT);
-            if assigned(ref.symbol) then
-              begin
-                objectlibrary.getjumplabel(l);
-                cg.a_label(current_procinfo.aktlocaldata,l);
-                tmpref.symboldata:=current_procinfo.aktlocaldata.last;
-
-                current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset));
-
-                { load consts entry }
-                tmpref.symbol:=l;
-                tmpref.base:=NR_R15;
-                list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
-              end
-            else
-              a_load_const_reg(list,OS_ADDR,ref.offset,tmpreg);
-
-            if (ref.base<>NR_NO) then
-              begin
-                if ref.index<>NR_NO then
-                  begin
-                    list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
-                    ref.base:=tmpreg;
-                  end
-                else
-                  begin
-                    ref.index:=tmpreg;
-                    ref.shiftimm:=0;
-                    ref.signindex:=1;
-                    ref.shiftmode:=SM_None;
-                  end;
-              end
-            else
-              ref.base:=tmpreg;
-            ref.offset:=0;
-            ref.symbol:=nil;
-          end;
-
-        if (ref.base<>NR_NO) and (ref.index<>NR_NO) and (ref.offset<>0) then
-          begin
-            if tmpreg<>NR_NO then
-              a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,tmpreg,tmpreg)
-            else
-              begin
-                tmpreg:=getintregister(list,OS_ADDR);
-                a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,ref.base,tmpreg);
-                ref.base:=tmpreg;
-              end;
-            ref.offset:=0;
-          end;
-
-        { floating point operations have only limited references
-          we expect here, that a base is already set }
-        if (op in [A_LDF,A_STF]) and (ref.index<>NR_NO) then
-          begin
-            if ref.shiftmode<>SM_none then
-              internalerror(200309121);
-            if tmpreg<>NR_NO then
-              begin
-                if ref.base=tmpreg then
-                  begin
-                    if ref.signindex<0 then
-                      list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,tmpreg,ref.index))
-                    else
-                      list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,tmpreg,ref.index));
-                    ref.index:=NR_NO;
-                  end
-                else
-                  begin
-                    if ref.index<>tmpreg then
-                      internalerror(200403161);
-                    if ref.signindex<0 then
-                      list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,ref.base,tmpreg))
-                    else
-                      list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
-                    ref.base:=tmpreg;
-                    ref.index:=NR_NO;
-                  end;
-              end
-            else
-              begin
-                tmpreg:=getintregister(list,OS_ADDR);
-                list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,ref.index));
-                ref.base:=tmpreg;
-                ref.index:=NR_NO;
-              end;
-          end;
-        list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix));
-      end;
-
-
-     procedure tcgarm.a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);
-       var
-         oppostfix:toppostfix;
-       begin
-         case ToSize of
-           { signed integer registers }
-           OS_8,
-           OS_S8:
-             oppostfix:=PF_B;
-           OS_16,
-           OS_S16:
-             oppostfix:=PF_H;
-           OS_32,
-           OS_S32:
-             oppostfix:=PF_None;
-           else
-             InternalError(200308295);
-         end;
-         handle_load_store(list,A_STR,oppostfix,reg,ref);
-       end;
-
-
-     procedure tcgarm.a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);
-       var
-         oppostfix:toppostfix;
-       begin
-         case FromSize of
-           { signed integer registers }
-           OS_8:
-             oppostfix:=PF_B;
-           OS_S8:
-             oppostfix:=PF_SB;
-           OS_16:
-             oppostfix:=PF_H;
-           OS_S16:
-             oppostfix:=PF_SH;
-           OS_32,
-           OS_S32:
-             oppostfix:=PF_None;
-           else
-             InternalError(200308291);
-         end;
-         handle_load_store(list,A_LDR,oppostfix,reg,ref);
-       end;
-
-
-     procedure tcgarm.a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister);
-       var
-         instr: taicpu;
-         so : tshifterop;
-       begin
-         shifterop_reset(so);
-         if (tcgsize2size[tosize] < tcgsize2size[fromsize]) or
-            (
-              (tcgsize2size[tosize] = tcgsize2size[fromsize]) and
-             (tosize <> fromsize) and
-             not(fromsize in [OS_32,OS_S32])
-            ) then
-           begin
-             case tosize of
-               OS_8:
-                 list.concat(taicpu.op_reg_reg_const(A_AND,
-                   reg2,reg1,$ff));
-               OS_S8:
-                 begin
-                   so.shiftmode:=SM_LSL;
-                   so.shiftimm:=24;
-                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so));
-                   so.shiftmode:=SM_ASR;
-                   so.shiftimm:=24;
-                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so));
-                 end;
-               OS_16:
-                 begin
-                   so.shiftmode:=SM_LSL;
-                   so.shiftimm:=16;
-                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so));
-                   so.shiftmode:=SM_LSR;
-                   so.shiftimm:=16;
-                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so));
-                 end;
-               OS_S16:
-                 begin
-                   so.shiftmode:=SM_LSL;
-                   so.shiftimm:=16;
-                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so));
-                   so.shiftmode:=SM_ASR;
-                   so.shiftimm:=16;
-                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so));
-                 end;
-               OS_32,OS_S32:
-                 begin
-                   instr:=taicpu.op_reg_reg(A_MOV,reg2,reg1);
-                   list.concat(instr);
-                   add_move_instruction(instr);
-                 end;
-               else internalerror(2002090901);
-             end;
-           end
-         else
-           begin
-             if reg1<>reg2 then
-               begin
-                 { same size, only a register mov required }
-                 instr:=taicpu.op_reg_reg(A_MOV,reg2,reg1);
-                 list.Concat(instr);
-                 { Notify the register allocator that we have written a move instruction so
-                   it can try to eliminate it. }
-                 add_move_instruction(instr);
-               end;
-           end;
-       end;
-
-
-    procedure tcgarm.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const paraloc : TCGPara);
-      var
-         href,href2 : treference;
-         hloc : pcgparalocation;
-      begin
-        href:=ref;
-        hloc:=paraloc.location;
-        while assigned(hloc) do
-          begin
-            case hloc^.loc of
-              LOC_FPUREGISTER,LOC_CFPUREGISTER:
-                a_loadfpu_ref_reg(list,size,ref,hloc^.register);
-              LOC_REGISTER :
-                a_load_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register);
-              LOC_REFERENCE :
-                begin
-                  reference_reset_base(href2,hloc^.reference.index,hloc^.reference.offset);
-                  a_load_ref_ref(list,hloc^.size,hloc^.size,href,href2);
-                end;
-              else
-                internalerror(200408241);
-           end;
-           inc(href.offset,tcgsize2size[hloc^.size]);
-           hloc:=hloc^.next;
-         end;
-      end;
-
-
-     procedure tcgarm.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister);
-       begin
-         list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[size]));
-       end;
-
-
-     procedure tcgarm.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
-       var
-         oppostfix:toppostfix;
-       begin
-         case size of
-           OS_F32:
-             oppostfix:=PF_S;
-           OS_F64:
-             oppostfix:=PF_D;
-           OS_F80:
-             oppostfix:=PF_E;
-           else
-             InternalError(200309021);
-         end;
-         handle_load_store(list,A_LDF,oppostfix,reg,ref);
-       end;
-
-
-     procedure tcgarm.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
-       var
-         oppostfix:toppostfix;
-       begin
-         case size of
-           OS_F32:
-             oppostfix:=PF_S;
-           OS_F64:
-             oppostfix:=PF_D;
-           OS_F80:
-             oppostfix:=PF_E;
-           else
-             InternalError(200309022);
-         end;
-         handle_load_store(list,A_STF,oppostfix,reg,ref);
-       end;
-
-
-    {  comparison operations }
-    procedure tcgarm.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
-      l : tasmlabel);
-      var
-        tmpreg : tregister;
-        b : byte;
-      begin
-        if is_shifter_const(a,b) then
-          list.concat(taicpu.op_reg_const(A_CMP,reg,a))
-        { CMN reg,0 and CMN reg,$80000000 are different from CMP reg,$ffffffff
-          and CMP reg,$7fffffff regarding the flags according to the ARM manual }
-        else if (a<>$7fffffff) and (a<>-1) and is_shifter_const(-a,b) then
-          list.concat(taicpu.op_reg_const(A_CMN,reg,-a))
-        else
-          begin
-            tmpreg:=getintregister(list,size);
-            a_load_const_reg(list,size,a,tmpreg);
-            list.concat(taicpu.op_reg_reg(A_CMP,reg,tmpreg));
-          end;
-        a_jmp_cond(list,cmp_op,l);
-      end;
-
-
-    procedure tcgarm.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
-      begin
-        list.concat(taicpu.op_reg_reg(A_CMP,reg2,reg1));
-        a_jmp_cond(list,cmp_op,l);
-      end;
-
-
-    procedure tcgarm.a_jmp_name(list : taasmoutput;const s : string);
-      begin
-        list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)));
-      end;
-
-
-    procedure tcgarm.a_jmp_always(list : taasmoutput;l: tasmlabel);
-      begin
-        list.concat(taicpu.op_sym(A_B,l));
-      end;
-
-
-    procedure tcgarm.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel);
-      var
-        ai : taicpu;
-      begin
-        ai:=setcondition(taicpu.op_sym(A_B,l),flags_to_cond(f));
-        ai.is_jmp:=true;
-        list.concat(ai);
-      end;
-
-
-    procedure tcgarm.g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister);
-      var
-        ai : taicpu;
-      begin
-        list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,1),flags_to_cond(f)));
-        list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,0),inverse_cond(flags_to_cond(f))));
-      end;
-
-
-    procedure tcgarm.g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);
-      var
-         ref : treference;
-         shift : byte;
-         firstfloatreg,lastfloatreg,
-         r : byte;
-      begin
-        LocalSize:=align(LocalSize,4);
-        if not(nostackframe) then
-          begin
-            firstfloatreg:=RS_NO;
-            { save floating point registers? }
-            for r:=RS_F0 to RS_F7 do
-              if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
-                begin
-                  if firstfloatreg=RS_NO then
-                    firstfloatreg:=r;
-                  lastfloatreg:=r;
-                end;
-            a_reg_alloc(list,NR_STACK_POINTER_REG);
-            a_reg_alloc(list,NR_FRAME_POINTER_REG);
-            a_reg_alloc(list,NR_R12);
-
-            list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_STACK_POINTER_REG));
-            { save int registers }
-            reference_reset(ref);
-            ref.index:=NR_STACK_POINTER_REG;
-            ref.addressmode:=AM_PREINDEXED;
-            list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,
-              rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R12,RS_R14,RS_R15]),
-              PF_FD));
-
-            list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4));
-
-            { allocate necessary stack size }
-            { don't use  a_op_const_reg_reg here because we don't allow register allocations
-              in the entry/exit code }
-            if not(is_shifter_const(localsize,shift)) then
-              begin
-                a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
-                list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
-                a_reg_dealloc(list,NR_R12);
-              end
-            else
-              begin
-                a_reg_dealloc(list,NR_R12);
-                list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
-              end;
-            if firstfloatreg<>RS_NO then
-              begin
-                reference_reset(ref);
-                if not(is_shifter_const(-tarmprocinfo(current_procinfo).floatregstart,shift)) then
-                  begin
-                    a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12);
-                    list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,NR_FRAME_POINTER_REG,NR_R12));
-                    ref.base:=NR_R12;
-                  end
-                else
-                  begin
-                    ref.base:=NR_FRAME_POINTER_REG;
-                    ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
-                  end;
-                list.concat(taicpu.op_reg_const_ref(A_SFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
-                  lastfloatreg-firstfloatreg+1,ref));
-              end;
-          end;
-      end;
-
-
-    procedure tcgarm.g_proc_exit(list : taasmoutput;parasize : longint;nostackframe:boolean);
-      var
-         ref : treference;
-         firstfloatreg,lastfloatreg,
-         r : byte;
-         shift : byte;
-      begin
-        if not(nostackframe) then
-          begin
-            { restore floating point register }
-            firstfloatreg:=RS_NO;
-            { save floating point registers? }
-            for r:=RS_F0 to RS_F7 do
-              if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
-                begin
-                  if firstfloatreg=RS_NO then
-                    firstfloatreg:=r;
-                  lastfloatreg:=r;
-                end;
-
-            if firstfloatreg<>RS_NO then
-              begin
-                reference_reset(ref);
-                if not(is_shifter_const(-tarmprocinfo(current_procinfo).floatregstart,shift)) then
-                  begin
-                    a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12);
-                    list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,NR_FRAME_POINTER_REG,NR_R12));
-                    ref.base:=NR_R12;
-                  end
-                else
-                  begin
-                    ref.base:=NR_FRAME_POINTER_REG;
-                    ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
-                  end;
-                list.concat(taicpu.op_reg_const_ref(A_LFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
-                  lastfloatreg-firstfloatreg+1,ref));
-              end;
-
-            if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
-              list.concat(taicpu.op_reg_reg(A_MOV,NR_R15,NR_R14))
-            else
-              begin
-                { restore int registers and return }
-                reference_reset(ref);
-                ref.index:=NR_FRAME_POINTER_REG;
-                list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R13,RS_R15]),PF_EA));
-              end;
-          end
-        else
-          list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R14));
-      end;
-
-
-    procedure tcgarm.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
-      var
-        b : byte;
-        tmpref : treference;
-        instr : taicpu;
-      begin
-        if ref.addressmode<>AM_OFFSET then
-          internalerror(200309071);
-        tmpref:=ref;
-        { Be sure to have a base register }
-        if (tmpref.base=NR_NO) then
-          begin
-            if tmpref.shiftmode<>SM_None then
-              internalerror(200308294);
-            if tmpref.signindex<0 then
-              internalerror(200312023);
-            tmpref.base:=tmpref.index;
-            tmpref.index:=NR_NO;
-          end;
-
-        if assigned(tmpref.symbol) or
-           not((is_shifter_const(tmpref.offset,b)) or
-               (is_shifter_const(-tmpref.offset,b))
-              ) then
-          fixref(list,tmpref);
-
-        { expect a base here if there is an index }
-        if (tmpref.base=NR_NO) and (tmpref.index<>NR_NO) then
-          internalerror(200312022);
-
-        if tmpref.index<>NR_NO then
-          begin
-            if tmpref.shiftmode<>SM_None then
-              internalerror(200312021);
-            if tmpref.signindex<0 then
-              a_op_reg_reg_reg(list,OP_SUB,OS_ADDR,tmpref.base,tmpref.index,r)
-            else
-              a_op_reg_reg_reg(list,OP_ADD,OS_ADDR,tmpref.base,tmpref.index,r);
-            if tmpref.offset<>0 then
-              a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,r,r);
-          end
-        else
-          begin
-            if tmpref.offset<>0 then
-              begin
-                if tmpref.base<>NR_NO then
-                  a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,tmpref.base,r)
-                else
-                  a_load_const_reg(list,OS_ADDR,tmpref.offset,r);
-              end
-            else
-              begin
-                instr:=taicpu.op_reg_reg(A_MOV,r,tmpref.base);
-                list.concat(instr);
-                add_move_instruction(instr);
-              end;
-          end;
-      end;
-
-
-    procedure tcgarm.fixref(list : taasmoutput;var ref : treference);
-      var
-        tmpreg : tregister;
-        tmpref : treference;
-        l : tasmlabel;
-      begin
-        { absolute symbols can't be handled directly, we've to store the symbol reference
-          in the text segment and access it pc relative
-
-          For now, we assume that references where base or index equals to PC are already
-          relative, all other references are assumed to be absolute and thus they need
-          to be handled extra.
-
-          A proper solution would be to change refoptions to a set and store the information
-          if the symbol is absolute or relative there.
-        }
-        { create consts entry }
-        reference_reset(tmpref);
-        objectlibrary.getjumplabel(l);
-        cg.a_label(current_procinfo.aktlocaldata,l);
-        tmpref.symboldata:=current_procinfo.aktlocaldata.last;
-
-        if assigned(ref.symbol) then
-          current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset))
-        else
-          current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
-
-        { load consts entry }
-        tmpreg:=getintregister(list,OS_INT);
-        tmpref.symbol:=l;
-        tmpref.base:=NR_PC;
-        list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
-
-        if (ref.base<>NR_NO) then
-          begin
-            if ref.index<>NR_NO then
-              begin
-                list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
-                ref.base:=tmpreg;
-              end
-            else
-              begin
-                ref.index:=tmpreg;
-                ref.shiftimm:=0;
-                ref.signindex:=1;
-                ref.shiftmode:=SM_None;
-              end;
-          end
-        else
-          ref.base:=tmpreg;
-
-        ref.offset:=0;
-        ref.symbol:=nil;
-      end;
-
-
-    procedure tcgarm.g_concatcopy_move(list : taasmoutput;const source,dest : treference;len : aint);
-      var
-        paraloc1,paraloc2,paraloc3 : TCGPara;
-      begin
-        paraloc1.init;
-        paraloc2.init;
-        paraloc3.init;
-        paramanager.getintparaloc(pocall_default,1,paraloc1);
-        paramanager.getintparaloc(pocall_default,2,paraloc2);
-        paramanager.getintparaloc(pocall_default,3,paraloc3);
-        paramanager.allocparaloc(list,paraloc3);
-        a_param_const(list,OS_INT,len,paraloc3);
-        paramanager.allocparaloc(list,paraloc2);
-        a_paramaddr_ref(list,dest,paraloc2);
-        paramanager.allocparaloc(list,paraloc2);
-        a_paramaddr_ref(list,source,paraloc1);
-        paramanager.freeparaloc(list,paraloc3);
-        paramanager.freeparaloc(list,paraloc2);
-        paramanager.freeparaloc(list,paraloc1);
-        alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-        alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
-        a_call_name(list,'FPC_MOVE');
-        dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
-        dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-        paraloc3.done;
-        paraloc2.done;
-        paraloc1.done;
-      end;
-
-
-    procedure tcgarm.g_concatcopy_internal(list : taasmoutput;const source,dest : treference;len : aint;aligned : boolean);
-      var
-        srcref,dstref:treference;
-        srcreg,destreg,countreg,r:tregister;
-        helpsize:aword;
-        copysize:byte;
-        cgsize:Tcgsize;
-
-      procedure genloop(count : aword;size : byte);
-        const
-          size2opsize : array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
-        var
-          l : tasmlabel;
-        begin
-          objectlibrary.getjumplabel(l);
-          a_load_const_reg(list,OS_INT,count,countreg);
-          cg.a_label(list,l);
-          srcref.addressmode:=AM_POSTINDEXED;
-          dstref.addressmode:=AM_POSTINDEXED;
-          srcref.offset:=size;
-          dstref.offset:=size;
-          r:=getintregister(list,size2opsize[size]);
-          a_load_ref_reg(list,size2opsize[size],size2opsize[size],srcref,r);
-          list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,countreg,countreg,1),PF_S));
-          a_load_reg_ref(list,size2opsize[size],size2opsize[size],r,dstref);
-          list.concat(setcondition(taicpu.op_sym(A_B,l),C_NE));
-          { keep the registers alive }
-          list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg));
-          list.concat(taicpu.op_reg_reg(A_MOV,srcreg,srcreg));
-          list.concat(taicpu.op_reg_reg(A_MOV,destreg,destreg));
-        end;
-
-      begin
-        if len=0 then
-          exit;
-        helpsize:=12;
-        dstref:=dest;
-        srcref:=source;
-        if cs_littlesize in aktglobalswitches then
-          helpsize:=8;
-        if (len<=helpsize) and aligned then
-          begin
-            copysize:=4;
-            cgsize:=OS_32;
-            while len<>0 do
-              begin
-                if len<2 then
-                  begin
-                    copysize:=1;
-                    cgsize:=OS_8;
-                  end
-                else if len<4 then
-                  begin
-                    copysize:=2;
-                    cgsize:=OS_16;
-                  end;
-                dec(len,copysize);
-                r:=getintregister(list,cgsize);
-                a_load_ref_reg(list,cgsize,cgsize,srcref,r);
-                a_load_reg_ref(list,cgsize,cgsize,r,dstref);
-                inc(srcref.offset,copysize);
-                inc(dstref.offset,copysize);
-              end;
-          end
-        else
-          begin
-            destreg:=getintregister(list,OS_ADDR);
-            a_loadaddr_ref_reg(list,dest,destreg);
-            reference_reset_base(dstref,destreg,0);
-
-            srcreg:=getintregister(list,OS_ADDR);
-            a_loadaddr_ref_reg(list,source,srcreg);
-            reference_reset_base(srcref,srcreg,0);
-
-            countreg:=getintregister(list,OS_32);
-
-//            if cs_littlesize in aktglobalswitches  then
-              genloop(len,1);
-{
-            else
-              begin
-                helpsize:=len shr 2;
-                len:=len and 3;
-                if helpsize>1 then
-                  begin
-                    a_load_const_reg(list,OS_INT,helpsize,countreg);
-                    list.concat(Taicpu.op_none(A_REP,S_NO));
-                  end;
-                if helpsize>0 then
-                  list.concat(Taicpu.op_none(A_MOVSD,S_NO));
-                if len>1 then
-                  begin
-                    dec(len,2);
-                    list.concat(Taicpu.op_none(A_MOVSW,S_NO));
-                  end;
-                if len=1 then
-                  list.concat(Taicpu.op_none(A_MOVSB,S_NO));
-                end;
-}
-          end;
-      end;
-
-
-    procedure tcgarm.g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint);
-      begin
-        g_concatcopy_internal(list,source,dest,len,false);
-      end;
-
-
-    procedure tcgarm.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint);
-      begin
-        g_concatcopy_internal(list,source,dest,len,true);
-      end;
-
-
-    procedure tcgarm.g_overflowCheck(list : taasmoutput;const l : tlocation;def : tdef);
-      var
-        ovloc : tlocation;
-      begin
-        ovloc.loc:=LOC_VOID;
-        g_overflowCheck_loc(list,l,def,ovloc);
-      end;
-
-
-    procedure tcgarm.g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);
-      var
-        hl : tasmlabel;
-        ai:TAiCpu;
-        hflags : tresflags;
-      begin
-        if not(cs_check_overflow in aktlocalswitches) then
-          exit;
-        objectlibrary.getjumplabel(hl);
-        case ovloc.loc of
-          LOC_VOID:
-            begin
-              ai:=taicpu.op_sym(A_B,hl);
-              ai.is_jmp:=true;
-
-              if not((def.deftype=pointerdef) or
-                    ((def.deftype=orddef) and
-                     (torddef(def).typ in [u64bit,u16bit,u32bit,u8bit,uchar,bool8bit,bool16bit,bool32bit]))) then
-                 ai.SetCondition(C_VC)
-              else
-                 ai.SetCondition(C_CC);
-
-              list.concat(ai);
-            end;
-          LOC_FLAGS:
-            begin
-              hflags:=ovloc.resflags;
-              inverse_flags(hflags);
-              cg.a_jmp_flags(list,hflags,hl);
-            end;
-          else
-            internalerror(200409281);
-        end;
-
-        a_call_name(list,'FPC_OVERFLOW');
-        a_label(list,hl);
-      end;
-
-
-    procedure tcgarm.g_save_standard_registers(list : taasmoutput);
-      begin
-        { this work is done in g_proc_entry }
-      end;
-
-
-    procedure tcgarm.g_restore_standard_registers(list : taasmoutput);
-      begin
-        { this work is done in g_proc_exit }
-      end;
-
-
-    procedure tcgarm.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
-      var
-        ai : taicpu;
-      begin
-        ai:=Taicpu.Op_sym(A_B,l);
-        ai.SetCondition(OpCmp2AsmCond[cond]);
-        ai.is_jmp:=true;
-        list.concat(ai);
-      end;
-
-
-    procedure tcgarm.g_intf_wrapper(list: taasmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);
-
-      procedure loadvmttor12;
-        var
-          href : treference;
-        begin
-          reference_reset_base(href,NR_R0,0);
-          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
-        end;
-
-
-      procedure op_onr12methodaddr;
-        var
-          href : treference;
-        begin
-          if (procdef.extnumber=$ffff) then
-            Internalerror(200006139);
-          { call/jmp  vmtoffs(%eax) ; method offs }
-          reference_reset_base(href,NR_R12,procdef._class.vmtmethodoffset(procdef.extnumber));
-          cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R12);
-          list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R12));
-        end;
-
-      var
-        lab : tasmsymbol;
-        make_global : boolean;
-        href : treference;
-      begin
-        if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
-          Internalerror(200006137);
-        if not assigned(procdef._class) or
-           (procdef.procoptions*[po_classmethod, po_staticmethod,
-             po_methodpointer, po_interrupt, po_iocheck]<>[]) then
-          Internalerror(200006138);
-        if procdef.owner.symtabletype<>objectsymtable then
-          Internalerror(200109191);
-
-        make_global:=false;
-        if (not current_module.is_unit) or
-           (cs_create_smart in aktmoduleswitches) or
-           (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
-          make_global:=true;
-
-        if make_global then
-          list.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
-        else
-          list.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
-
-        { set param1 interface to self  }
-        g_adjust_self_value(list,procdef,ioffset);
-
-        { case 4 }
-        if po_virtualmethod in procdef.procoptions then
-          begin
-            loadvmttor12;
-            op_onr12methodaddr;
-          end
-        { case 0 }
-        else
-          list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(procdef.mangledname,AB_EXTERNAL,AT_FUNCTION)));
-
-        list.concat(Tai_symbol_end.Createname(labelname));
-      end;
-
-
-    procedure tcg64farm.a_op64_reg_reg(list : taasmoutput;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);
-      var
-        tmpreg : tregister;
-      begin
-        case op of
-          OP_NEG:
-            begin
-              list.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0),PF_S));
-              list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0));
-            end;
-          OP_NOT:
-            begin
-              cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reglo,regdst.reglo);
-              cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reghi,regdst.reghi);
-            end;
-          else
-            a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst);
-        end;
-      end;
-
-
-    procedure tcg64farm.a_op64_const_reg(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);
-      begin
-        a_op64_const_reg_reg(list,op,size,value,reg,reg);
-      end;
-
-
-    procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);
-      var
-        ovloc : tlocation;
-      begin
-        a_op64_const_reg_reg_checkoverflow(list,op,size,value,regsrc,regdst,false,ovloc);
-      end;
-
-
-    procedure tcg64farm.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
-      var
-        ovloc : tlocation;
-      begin
-        a_op64_reg_reg_reg_checkoverflow(list,op,size,regsrc1,regsrc2,regdst,false,ovloc);
-      end;
-
-
-    procedure tcg64farm.a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
-      var
-        tmpreg : tregister;
-        b : byte;
-      begin
-        ovloc.loc:=LOC_VOID;
-        case op of
-          OP_NEG,
-          OP_NOT :
-            internalerror(200306017);
-        end;
-        if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then
-          begin
-            case op of
-              OP_ADD:
-                begin
-                  if is_shifter_const(lo(value),b) then
-                    list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
-                  else
-                    begin
-                      tmpreg:=cg.getintregister(list,OS_32);
-                      cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
-                      list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
-                    end;
-
-                  if is_shifter_const(hi(value),b) then
-                    list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)),PF_S))
-                  else
-                    begin
-                      tmpreg:=cg.getintregister(list,OS_32);
-                      cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
-                      list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg),PF_S));
-                    end;
-                end;
-              OP_SUB:
-                begin
-                  if is_shifter_const(lo(value),b) then
-                    list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
-                  else
-                    begin
-                      tmpreg:=cg.getintregister(list,OS_32);
-                      cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
-                      list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
-                    end;
-
-                  if is_shifter_const(hi(value),b) then
-                    list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)),PF_S))
-                  else
-                    begin
-                      tmpreg:=cg.getintregister(list,OS_32);
-                      cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
-                      list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg),PF_S));
-                    end;
-                end;
-              else
-                internalerror(200502131);
-            end;
-            if size=OS_64 then
-              begin
-                { the arm has an weired opinion how flags for SUB/ADD are handled }
-                ovloc.loc:=LOC_FLAGS;
-                case op of
-                  OP_ADD:
-                    ovloc.resflags:=F_CS;
-                  OP_SUB:
-                    ovloc.resflags:=F_CC;
-                end;
-              end;
-          end
-        else
-          begin
-            case op of
-              OP_AND,OP_OR,OP_XOR:
-                begin
-                  cg.a_op_const_reg_reg(list,op,OS_32,lo(value),regsrc.reglo,regdst.reglo);
-                  cg.a_op_const_reg_reg(list,op,OS_32,hi(value),regsrc.reghi,regdst.reghi);
-                end;
-              OP_ADD:
-                begin
-                  if is_shifter_const(lo(value),b) then
-                    list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
-                  else
-                    begin
-                      tmpreg:=cg.getintregister(list,OS_32);
-                      cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
-                      list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
-                    end;
-
-                  if is_shifter_const(hi(value),b) then
-                    list.concat(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)))
-                  else
-                    begin
-                      tmpreg:=cg.getintregister(list,OS_32);
-                      cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
-                      list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg));
-                    end;
-                end;
-              OP_SUB:
-                begin
-                  if is_shifter_const(lo(value),b) then
-                    list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
-                  else
-                    begin
-                      tmpreg:=cg.getintregister(list,OS_32);
-                      cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
-                      list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
-                    end;
-
-                  if is_shifter_const(hi(value),b) then
-                    list.concat(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)))
-                  else
-                    begin
-                      tmpreg:=cg.getintregister(list,OS_32);
-                      cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
-                      list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg));
-                    end;
-                end;
-            else
-              internalerror(2003083101);
-          end;
-        end;
-      end;
-
-
-    procedure tcg64farm.a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
-      var
-        op1,op2:TAsmOp;
-      begin
-        ovloc.loc:=LOC_VOID;
-        case op of
-          OP_NEG,
-          OP_NOT :
-            internalerror(200306017);
-        end;
-        if (setflags or tcgarm(cg).cgsetflags) and (op in [OP_ADD,OP_SUB]) then
-          begin
-            case op of
-              OP_ADD:
-                begin
-                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
-                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi),PF_S));
-                end;
-              OP_SUB:
-                begin
-                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
-                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi),PF_S));
-                end;
-              else
-                internalerror(2003083101);
-            end;
-            if size=OS_64 then
-              begin
-                { the arm has an weired opinion how flags for SUB/ADD are handled }
-                ovloc.loc:=LOC_FLAGS;
-                case op of
-                  OP_ADD:
-                    ovloc.resflags:=F_CC;
-                  OP_SUB:
-                    ovloc.resflags:=F_CS;
-                end;
-              end;
-          end
-        else
-          begin
-            case op of
-              OP_AND,OP_OR,OP_XOR:
-                begin
-                  cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reglo,regsrc2.reglo,regdst.reglo);
-                  cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reghi,regsrc2.reghi,regdst.reghi);
-                end;
-              OP_ADD:
-                begin
-                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
-                  list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
-                end;
-              OP_SUB:
-                begin
-                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
-                  list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi));
-                end;
-              else
-                internalerror(2003083101);
-            end;
-          end;
-      end;
-
-
-begin
-  cg:=tcgarm.create;
-  cg64:=tcg64farm.create;
-end.

compiler/compiler/arm/cpubase.pas

@@ -1,520 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
-
-    Contains the base types for the ARM
-
-    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.
-
- ****************************************************************************
-}
-{# Base unit for processor information. This unit contains
-   enumerations of registers, opcodes, sizes, and other
-   such things which are processor specific.
-}
-unit cpubase;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-      cutils,cclasses,
-      globtype,globals,
-      cpuinfo,
-      aasmbase,
-      cgbase
-      ;
-
-
-{*****************************************************************************
-                                Assembler Opcodes
-*****************************************************************************}
-
-    type
-      TAsmOp= {$i armop.inc}
-
-      { This should define the array of instructions as string }
-      op2strtable=array[tasmop] of string[11];
-
-    const
-      { First value of opcode enumeration }
-      firstop = low(tasmop);
-      { Last value of opcode enumeration  }
-      lastop  = high(tasmop);
-
-{*****************************************************************************
-                                  Registers
-*****************************************************************************}
-
-    type
-      { Number of registers used for indexing in tables }
-      tregisterindex=0..{$i rarmnor.inc}-1;
-
-    const
-      { Available Superregisters }
-      {$i rarmsup.inc}
-
-      RS_PC = RS_R15;
-
-      { No Subregisters }
-      R_SUBWHOLE = R_SUBNONE;
-
-      { Available Registers }
-      {$i rarmcon.inc}
-
-      { aliases }
-      NR_PC = NR_R15;
-
-      { Integer Super registers first and last }
-      first_int_supreg = RS_R0;
-      first_int_imreg = $10;
-
-      { Float Super register first and last }
-      first_fpu_supreg    = RS_F0;
-      first_fpu_imreg     = $08;
-
-      { MM Super register first and last }
-      first_mm_supreg    = RS_S0;
-      first_mm_imreg     = $20;
-
-{$warning TODO Calculate bsstart}
-      regnumber_count_bsstart = 64;
-
-      regnumber_table : array[tregisterindex] of tregister = (
-        {$i rarmnum.inc}
-      );
-
-      regstabs_table : array[tregisterindex] of shortint = (
-        {$i rarmsta.inc}
-      );
-
-      regdwarf_table : array[tregisterindex] of shortint = (
-        {$i rarmdwa.inc}
-      );
-      { registers which may be destroyed by calls }
-      VOLATILE_INTREGISTERS = [RS_R0..RS_R3,RS_R12..RS_R15];
-      VOLATILE_FPUREGISTERS = [RS_F0..RS_F3];
-
-    type
-      totherregisterset = set of tregisterindex;
-
-{*****************************************************************************
-                          Instruction post fixes
-*****************************************************************************}
-    type
-      { ARM instructions load/store and arithmetic instructions
-        can have several instruction post fixes which are collected
-        in this enumeration
-      }
-      TOpPostfix = (PF_None,
-        { update condition flags
-          or floating point single }
-        PF_S,
-        { floating point size }
-        PF_D,PF_E,PF_P,PF_EP,
-        { load/store }
-        PF_B,PF_SB,PF_BT,PF_H,PF_SH,PF_T,
-        { multiple load/store address modes }
-        PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA
-      );
-
-      TRoundingMode = (RM_None,RM_P,RM_M,RM_Z);
-
-    const
-      cgsize2fpuoppostfix : array[OS_NO..OS_F128] of toppostfix = (
-        PF_E,
-        PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,PF_None,
-        PF_S,PF_D,PF_E,PF_None,PF_None);
-
-      oppostfix2str : array[TOpPostfix] of string[2] = ('',
-        's',
-        'd','e','p','ep',
-        'b','sb','bt','h','sh','t',
-        'ia','ib','da','db','fd','fa','ed','ea');
-
-      roundingmode2str : array[TRoundingMode] of string[1] = ('',
-        'p','m','z');
-
-{*****************************************************************************
-                                Conditions
-*****************************************************************************}
-
-    type
-      TAsmCond=(C_None,
-        C_EQ,C_NE,C_CS,C_CC,C_MI,C_PL,C_VS,C_VC,C_HI,C_LS,
-        C_GE,C_LT,C_GT,C_LE,C_AL,C_NV
-      );
-
-    const
-      cond2str : array[TAsmCond] of string[2]=('',
-        'eq','ne','cs','cc','mi','pl','vs','vc','hi','ls',
-        'ge','lt','gt','le','al','nv'
-      );
-
-      uppercond2str : array[TAsmCond] of string[2]=('',
-        'EQ','NE','CS','CC','MI','PL','VS','VC','HI','LS',
-        'GE','LT','GT','LE','AL','NV'
-      );
-
-{*****************************************************************************
-                                   Flags
-*****************************************************************************}
-
-    type
-      TResFlags = (F_EQ,F_NE,F_CS,F_CC,F_MI,F_PL,F_VS,F_VC,F_HI,F_LS,
-        F_GE,F_LT,F_GT,F_LE);
-
-{*****************************************************************************
-                                Operands
-*****************************************************************************}
-
-      taddressmode = (AM_OFFSET,AM_PREINDEXED,AM_POSTINDEXED);
-      tshiftmode = (SM_None,SM_LSL,SM_LSR,SM_ASR,SM_ROR,SM_RRX);
-
-      tupdatereg = (UR_None,UR_Update);
-
-      pshifterop = ^tshifterop;
-
-      tshifterop = record
-        shiftmode : tshiftmode;
-        rs : tregister;
-        shiftimm : byte;
-      end;
-
-{*****************************************************************************
-                                 Constants
-*****************************************************************************}
-
-    const
-      max_operands = 4;
-
-      {# Constant defining possibly all registers which might require saving }
-      ALL_OTHERREGISTERS = [];
-
-      general_superregisters = [RS_R0..RS_PC];
-
-      {# Table of registers which can be allocated by the code generator
-         internally, when generating the code.
-      }
-      { legend:                                                                }
-      { xxxregs = set of all possibly used registers of that type in the code  }
-      {           generator                                                    }
-      { usableregsxxx = set of all 32bit components of registers that can be   }
-      {           possible allocated to a regvar or using getregisterxxx (this }
-      {           excludes registers which can be only used for parameter      }
-      {           passing on ABI's that define this)                           }
-      { c_countusableregsxxx = amount of registers in the usableregsxxx set    }
-
-      maxintregs = 15;
-      { to determine how many registers to use for regvars }
-      maxintscratchregs = 3;
-      usableregsint = [RS_R4..RS_R10];
-      c_countusableregsint = 7;
-
-      maxfpuregs = 8;
-      fpuregs = [RS_F0..RS_F7];
-      usableregsfpu = [RS_F4..RS_F7];
-      c_countusableregsfpu = 4;
-
-      mmregs = [RS_D0..RS_D15];
-      usableregsmm = [RS_D8..RS_D15];
-      c_countusableregsmm  = 8;
-
-      maxaddrregs = 0;
-      addrregs    = [];
-      usableregsaddr = [];
-      c_countusableregsaddr = 0;
-
-{*****************************************************************************
-                                Operand Sizes
-*****************************************************************************}
-
-    type
-      topsize = (S_NO,
-        S_B,S_W,S_L,S_BW,S_BL,S_WL,
-        S_IS,S_IL,S_IQ,
-        S_FS,S_FL,S_FX,S_D,S_Q,S_FV,S_FXX
-      );
-
-{*****************************************************************************
-                                 Constants
-*****************************************************************************}
-
-    const
-      firstsaveintreg = RS_R4;
-      lastsaveintreg  = RS_R10;
-      firstsavefpureg = RS_F4;
-      lastsavefpureg  = RS_F7;
-      firstsavemmreg  = RS_D8;
-      lastsavemmreg   = RS_D15;
-
-      maxvarregs = 7;
-      varregs : Array [1..maxvarregs] of tsuperregister =
-                (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10);
-
-      maxfpuvarregs = 4;
-      fpuvarregs : Array [1..maxfpuvarregs] of tsuperregister =
-                (RS_F4,RS_F5,RS_F6,RS_F7);
-
-{*****************************************************************************
-                          Default generic sizes
-*****************************************************************************}
-
-      { Defines the default address size for a processor, }
-      OS_ADDR = OS_32;
-      { the natural int size for a processor,             }
-      OS_INT = OS_32;
-      OS_SINT = OS_S32;
-      { the maximum float size for a processor,           }
-      OS_FLOAT = OS_F64;
-      { the size of a vector register for a processor     }
-      OS_VECTOR = OS_M32;
-
-{*****************************************************************************
-                          Generic Register names
-*****************************************************************************}
-
-      { Stack pointer register }
-      NR_STACK_POINTER_REG = NR_R13;
-      RS_STACK_POINTER_REG = RS_R13;
-      { Frame pointer register }
-      RS_FRAME_POINTER_REG = RS_R11;
-      NR_FRAME_POINTER_REG = NR_R11;
-      { Register for addressing absolute data in a position independant way,
-        such as in PIC code. The exact meaning is ABI specific. For
-        further information look at GCC source : PIC_OFFSET_TABLE_REGNUM
-      }
-      NR_PIC_OFFSET_REG = NR_R9;
-      { Results are returned in this register (32-bit values) }
-      NR_FUNCTION_RETURN_REG = NR_R0;
-      RS_FUNCTION_RETURN_REG = RS_R0;
-      { Low part of 64bit return value }
-      NR_FUNCTION_RETURN64_LOW_REG = NR_R0;
-      RS_FUNCTION_RETURN64_LOW_REG = RS_R0;
-      { High part of 64bit return value }
-      NR_FUNCTION_RETURN64_HIGH_REG = NR_R1;
-      RS_FUNCTION_RETURN64_HIGH_REG = RS_R1;
-      { The value returned from a function is available in this register }
-      NR_FUNCTION_RESULT_REG = NR_FUNCTION_RETURN_REG;
-      RS_FUNCTION_RESULT_REG = RS_FUNCTION_RETURN_REG;
-      { The lowh part of 64bit value returned from a function }
-      NR_FUNCTION_RESULT64_LOW_REG = NR_FUNCTION_RETURN64_LOW_REG;
-      RS_FUNCTION_RESULT64_LOW_REG = RS_FUNCTION_RETURN64_LOW_REG;
-      { The high part of 64bit value returned from a function }
-      NR_FUNCTION_RESULT64_HIGH_REG = NR_FUNCTION_RETURN64_HIGH_REG;
-      RS_FUNCTION_RESULT64_HIGH_REG = RS_FUNCTION_RETURN64_HIGH_REG;
-
-      NR_FPU_RESULT_REG = NR_F0;
-
-      NR_MM_RESULT_REG  = NR_NO;
-
-      NR_RETURN_ADDRESS_REG = NR_FUNCTION_RETURN_REG;
-
-      { Offset where the parent framepointer is pushed }
-      PARENT_FRAMEPOINTER_OFFSET = 0;
-
-{*****************************************************************************
-                       GCC /ABI linking information
-*****************************************************************************}
-
-    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.
-      }
-      saved_standard_registers : array[0..6] of tsuperregister =
-        (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10);
-      { 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 = 4;
-
-
-{*****************************************************************************
-                                  Helpers
-*****************************************************************************}
-
-    { Returns the tcgsize corresponding with the size of reg.}
-    function reg_cgsize(const reg: tregister) : tcgsize;
-    function cgsize2subreg(s:Tcgsize):Tsubregister;
-    function is_calljmp(o:tasmop):boolean;
-    procedure inverse_flags(var f: TResFlags);
-    function flags_to_cond(const f: TResFlags) : TAsmCond;
-    function findreg_by_number(r:Tregister):tregisterindex;
-    function std_regnum_search(const s:string):Tregister;
-    function std_regname(r:Tregister):string;
-
-    function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
-    function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
-
-    procedure shifterop_reset(var so : tshifterop);
-    function is_pc(const r : tregister) : boolean;
-
-    function is_shifter_const(d : aint;var imm_shift : byte) : boolean;
-
-  implementation
-
-    uses
-      rgBase,verbose;
-
-
-    const
-      std_regname_table : array[tregisterindex] of string[7] = (
-        {$i rarmstd.inc}
-      );
-
-      regnumber_index : array[tregisterindex] of tregisterindex = (
-        {$i rarmrni.inc}
-      );
-
-      std_regname_index : array[tregisterindex] of tregisterindex = (
-        {$i rarmsri.inc}
-      );
-
-
-    function cgsize2subreg(s:Tcgsize):Tsubregister;
-      begin
-        cgsize2subreg:=R_SUBWHOLE;
-      end;
-
-
-    function reg_cgsize(const reg: tregister): tcgsize;
-      const subreg2cgsize:array[Tsubregister] of Tcgsize =
-            (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO,OS_NO,OS_NO,OS_NO);
-      begin
-        case getregtype(reg) of
-          R_INTREGISTER :
-            reg_cgsize:=OS_32;
-          R_FPUREGISTER :
-            reg_cgsize:=OS_F80;
-          else
-            internalerror(200303181);
-          end;
-        end;
-
-
-    function is_calljmp(o:tasmop):boolean;
-      begin
-        { This isn't 100% perfect because the arm allows jumps also by writing to PC=R15.
-          To overcome this problem we simply forbid that FPC generates jumps by loading R15 }
-        is_calljmp:= o in [A_B,A_BL,A_BX,A_BLX];
-      end;
-
-
-    procedure inverse_flags(var f: TResFlags);
-      const
-        inv_flags: array[TResFlags] of TResFlags =
-          (F_NE,F_EQ,F_CC,F_CS,F_PL,F_MI,F_VC,F_VS,F_LS,F_HI,
-          F_LT,F_GE,F_LE,F_GT);
-      begin
-        f:=inv_flags[f];
-      end;
-
-
-    function flags_to_cond(const f: TResFlags) : TAsmCond;
-      const
-        flag_2_cond: array[F_EQ..F_LE] of TAsmCond =
-          (C_EQ,C_NE,C_CS,C_CC,C_MI,C_PL,C_VS,C_VC,C_HI,C_LS,
-           C_GE,C_LT,C_GT,C_LE);
-      begin
-        if f>high(flag_2_cond) then
-          internalerror(200112301);
-        result:=flag_2_cond[f];
-      end;
-
-
-    function findreg_by_number(r:Tregister):tregisterindex;
-      begin
-        result:=rgBase.findreg_by_number_table(r,regnumber_index);
-      end;
-
-
-    function std_regnum_search(const s:string):Tregister;
-      begin
-        result:=regnumber_table[findreg_by_name_table(s,std_regname_table,std_regname_index)];
-      end;
-
-
-    function std_regname(r:Tregister):string;
-      var
-        p : tregisterindex;
-      begin
-        p:=findreg_by_number_table(r,regnumber_index);
-        if p<>0 then
-          result:=std_regname_table[p]
-        else
-          result:=generic_regname(r);
-      end;
-
-
-    procedure shifterop_reset(var so : tshifterop);
-      begin
-        FillChar(so,sizeof(so),0);
-      end;
-
-
-    function is_pc(const r : tregister) : boolean;
-      begin
-        is_pc:=(r=NR_R15);
-      end;
-
-
-    function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
-      const
-        inverse: array[TAsmCond] of TAsmCond=(C_None,
-          C_NE,C_EQ,C_CC,C_CS,C_PL,C_MI,C_VC,C_VS,C_LS,C_HI,
-          C_LT,C_GE,C_LE,C_GT,C_None,C_None
-        );
-      begin
-        result := inverse[c];
-      end;
-
-
-    function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
-      begin
-        result := c1 = c2;
-      end;
-
-
-    function rotl(d : dword;b : byte) : dword;
-      begin
-         result:=(d shr (32-b)) or (d shl b);
-      end;
-
-
-    function is_shifter_const(d : aint;var imm_shift : byte) : boolean;
-      var
-         i : longint;
-      begin
-         for i:=0 to 15 do
-           begin
-              if (dword(d) and not(rotl($ff,i*2)))=0 then
-                begin
-                   imm_shift:=i*2;
-                   result:=true;
-                   exit;
-                end;
-           end;
-         result:=false;
-      end;
-
-end.

compiler/compiler/arm/cpuinfo.pas

@@ -1,88 +0,0 @@
-{
-    Copyright (c) 1998-2002 by the Free Pascal development team
-
-    Basic Processor information for the ARM
-
-    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.
-
- **********************************************************************}
-
-Unit CPUInfo;
-
-Interface
-
-  uses
-    globtype;
-
-Type
-   bestreal = double;
-   ts32real = single;
-   ts64real = double;
-   ts80real = type extended;
-   ts128real = type extended;
-   ts64comp = comp;
-
-   pbestreal=^bestreal;
-
-   { possible supported processors for this target }
-   tprocessors =
-      (no_processor,
-       armv3,
-       armv4,
-       armv5
-      );
-
-   tfputype =
-     (no_fpuprocessor,
-      fpu_soft,
-      fpu_libgcc,
-      fpu_fpa,
-      fpu_fpa10,
-      fpu_fpa11,
-      fpu_vfp
-     );
-
-Const
-   {# Size of native extended floating point type }
-   extended_size = 12;
-   {# Size of a multimedia register               }
-   mmreg_size = 16;
-   { target cpu string (used by compiler options) }
-   target_cpu_string = 'arm';
-
-   { calling conventions supported by the code generator }
-   supported_calling_conventions : tproccalloptions = [
-     pocall_internproc,
-     pocall_stdcall,
-     { same as stdcall only different name mangling }
-     pocall_cdecl,
-     { same as stdcall only different name mangling }
-     pocall_cppdecl,
-     { same as stdcall but floating point numbers are handled like equal sized integers }
-     pocall_softfloat
-   ];
-
-   processorsstr : array[tprocessors] of string[5] = ('',
-     'ARMV3',
-     'ARMV4',
-     'ARMV5'
-   );
-
-   fputypestr : array[tfputype] of string[6] = ('',
-     'SOFT',
-     'LIBGCC',
-     'FPA',
-     'FPA10',
-     'FPA11',
-     'VFP'
-   );
-
-
-Implementation
-
-end.

compiler/compiler/arm/cpunode.pas

@@ -1,46 +0,0 @@
-{
-    Copyright (c) 2000-2003 by Florian Klaempfl
-
-    This unit includes the ARM code generator into the compiler
-
-    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 cpunode;
-
-{$i fpcdefs.inc}
-
-  interface
-
-  implementation
-
-    uses
-       { generic nodes }
-       ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt,ncgmat,
-       { to be able to only parts of the generic code,
-         the processor specific nodes must be included
-         after the generic one (FK)
-       }
-       narmadd,
-       narmcal,
-       narmmat,
-       narminl,
-       narmcnv,
-       narmcon
-       ;
-
-
-end.

compiler/compiler/arm/cpupara.pas

@@ -1,496 +0,0 @@
-{
-    Copyright (c) 2003 by Florian Klaempfl
-
-    ARM 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.
- ****************************************************************************
-}
-{ ARM specific calling conventions are handled by this unit
-}
-unit cpupara;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-       globtype,globals,
-       aasmtai,
-       cpuinfo,cpubase,cgbase,
-       symconst,symbase,symtype,symdef,parabase,paramgr;
-
-    type
-       tarmparamanager = class(tparamanager)
-          function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
-          function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
-          function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
-          procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override;
-          function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
-         private
-          procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
-          function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
-            var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
-       end;
-
-  implementation
-
-    uses
-       verbose,systems,
-       rgobj,
-       defutil,symsym,
-       cgutils;
-
-
-    function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
-      begin
-        result:=VOLATILE_INTREGISTERS;
-      end;
-
-
-    function tarmparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
-      begin
-        result:=VOLATILE_FPUREGISTERS;
-      end;
-
-
-    procedure tarmparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);
-      var
-        paraloc : pcgparalocation;
-      begin
-        if nr<1 then
-          internalerror(2002070801);
-        cgpara.reset;
-        cgpara.size:=OS_INT;
-        cgpara.intsize:=tcgsize2size[OS_INT];
-        cgpara.alignment:=std_param_align;
-        paraloc:=cgpara.add_location;
-        with paraloc^ do
-          begin
-            size:=OS_INT;
-            { the four first parameters are passed into registers }
-            if nr<=4 then
-              begin
-                loc:=LOC_REGISTER;
-                register:=newreg(R_INTREGISTER,RS_R0+nr-1,R_SUBWHOLE);
-              end
-            else
-              begin
-                { the other parameters are passed on the stack }
-                loc:=LOC_REFERENCE;
-                reference.index:=NR_STACK_POINTER_REG;
-                reference.offset:=(nr-5)*4;
-              end;
-          end;
-      end;
-
-
-    function getparaloc(calloption : tproccalloption; p : tdef) : tcgloc;
-      begin
-         { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
-           if push_addr_param for the def is true
-         }
-         case p.deftype of
-            orddef:
-              getparaloc:=LOC_REGISTER;
-            floatdef:
-              if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or (cs_fp_emulation in aktmoduleswitches) then
-                getparaloc:=LOC_REGISTER
-              else
-                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;
-
-
-    function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
-      begin
-        result:=false;
-        if varspez in [vs_var,vs_out] then
-          begin
-            result:=true;
-            exit;
-          end;
-        case def.deftype of
-          variantdef,
-          formaldef,
-          recorddef:
-            result:=true;
-          arraydef:
-            result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
-                             is_open_array(def) or
-                             is_array_of_const(def) or
-                             is_array_constructor(def);
-          objectdef :
-            result:=is_object(def);
-          setdef :
-            result:=(tsetdef(def).settype<>smallset);
-          stringdef :
-            result:=tstringdef(def).string_typ in [st_shortstring,st_longstring];
-          procvardef :
-            result:=po_methodpointer in tprocvardef(def).procoptions;
-        end;
-      end;
-
-
-    procedure tarmparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
-      begin
-        curintreg:=RS_R0;
-        curfloatreg:=RS_F0;
-        curmmreg:=RS_D0;
-        cur_stack_offset:=0;
-      end;
-
-
-    function tarmparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
-        var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
-
-      var
-        nextintreg,nextfloatreg,nextmmreg : tsuperregister;
-        paradef : tdef;
-        paraloc : pcgparalocation;
-        stack_offset : aword;
-        hp : tparavarsym;
-        loc : tcgloc;
-        paracgsize   : tcgsize;
-        paralen : longint;
-        i : integer;
-
-      procedure assignintreg;
-        begin
-           if nextintreg<=RS_R3 then
-             begin
-               paraloc^.loc:=LOC_REGISTER;
-               paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
-               inc(nextintreg);
-             end
-           else
-             begin
-               paraloc^.loc:=LOC_REFERENCE;
-               paraloc^.reference.index:=NR_STACK_POINTER_REG;
-               paraloc^.reference.offset:=stack_offset;
-               inc(stack_offset,4);
-            end;
-        end;
-
-
-      begin
-        result:=0;
-        nextintreg:=curintreg;
-        nextfloatreg:=curfloatreg;
-        nextmmreg:=curmmreg;
-        stack_offset:=cur_stack_offset;
-
-        for i:=0 to paras.count-1 do
-          begin
-            hp:=tparavarsym(paras[i]);
-            { currently only support C-style array of const,
-              there should be no location assigned to the vararg array itself }
-            if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
-               is_array_of_const(hp.vartype.def) then
-              begin
-                paraloc:=hp.paraloc[side].add_location;
-                { hack: the paraloc must be valid, but is not actually used }
-                paraloc^.loc:=LOC_REGISTER;
-                paraloc^.register:=NR_R0;
-                paraloc^.size:=OS_ADDR;
-                break;
-              end;
-
-            if push_addr_param(hp.varspez,hp.vartype.def,p.proccalloption) then
-              paracgsize:=OS_ADDR
-            else
-              begin
-                paracgsize:=def_cgSize(hp.vartype.def);
-                if paracgsize=OS_NO then
-                  paracgsize:=OS_ADDR;
-              end;
-
-             hp.paraloc[side].reset;
-             hp.paraloc[side].size:=paracgsize;
-             hp.paraloc[side].Alignment:=std_param_align;
-
-             if (hp.varspez in [vs_var,vs_out]) then
-               begin
-                 paradef:=voidpointertype.def;
-                 loc:=LOC_REGISTER;
-               end
-             else
-               begin
-                 paradef:=hp.vartype.def;
-                 loc:=getparaloc(p.proccalloption,paradef);
-               end;
-
-             paralen:=tcgsize2size[paracgsize];
-             hp.paraloc[side].intsize:=paralen;
-{$ifdef EXTDEBUG}
-             if paralen=0 then
-               internalerror(200410311);
-{$endif EXTDEBUG}
-             while paralen>0 do
-               begin
-                 paraloc:=hp.paraloc[side].add_location;
-                 { for things like formaldef }
-                 if paracgsize=OS_NO then
-                   paraloc^.size:=OS_ADDR
-                 else if paracgsize in [OS_64,OS_S64] then
-                   paraloc^.size:=OS_32
-                 else if (loc=LOC_REGISTER) and (paracgsize in [OS_F32,OS_F64,OS_F80]) then
-                   case paracgsize of
-                     OS_F32:
-                       paraloc^.size:=OS_32;
-                     OS_F64:
-                       paraloc^.size:=OS_64;
-                     else
-                       internalerror(2005082901);
-                   end
-                 else
-                   paraloc^.size:=paracgsize;
-                 case loc of
-                    LOC_REGISTER:
-                      begin
-                        { this is not abi compliant }
-                        if nextintreg<=RS_R3 then
-                          begin
-                            paraloc^.loc:=LOC_REGISTER;
-                            paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
-                            inc(nextintreg);
-                          end
-                        else
-                          begin
-                            { LOC_REFERENCE covers always the overleft }
-                            paraloc^.loc:=LOC_REFERENCE;
-                            paraloc^.size:=int_cgsize(paralen);
-                            if (side=callerside) then
-                              paraloc^.reference.index:=NR_STACK_POINTER_REG;
-                            paraloc^.reference.offset:=stack_offset;
-                            inc(stack_offset,align(paralen,4));
-                            paralen:=0;
-                         end;
-                      end;
-                    LOC_FPUREGISTER:
-                      begin
-                        if nextfloatreg<=RS_F3 then
-                          begin
-                            paraloc^.loc:=LOC_FPUREGISTER;
-                            paraloc^.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE);
-                            inc(nextfloatreg);
-                          end
-                        else
-                          begin
-                            paraloc^.loc:=LOC_REFERENCE;
-                            paraloc^.reference.index:=NR_STACK_POINTER_REG;
-                            paraloc^.reference.offset:=stack_offset;
-                            case paraloc^.size of
-                              OS_F32:
-                                inc(stack_offset,4);
-                              OS_F64:
-                                inc(stack_offset,8);
-                              OS_F80:
-                                inc(stack_offset,10);
-                              OS_F128:
-                                inc(stack_offset,16);
-                              else
-                                internalerror(200403201);
-                            end;
-                          end;
-                      end;
-                    LOC_REFERENCE:
-                      begin
-                        paraloc^.size:=OS_ADDR;
-                        if push_addr_param(hp.varspez,paradef,p.proccalloption) or
-                          is_open_array(paradef) or
-                          is_array_of_const(paradef) then
-                          assignintreg
-                        else
-                          begin
-                             paraloc^.loc:=LOC_REFERENCE;
-                             paraloc^.reference.index:=NR_STACK_POINTER_REG;
-                             paraloc^.reference.offset:=stack_offset;
-                             inc(stack_offset,hp.vartype.def.size);
-                          end;
-                      end;
-                    else
-                      internalerror(2002071002);
-                 end;
-                 if side=calleeside then
-                   begin
-                     if paraloc^.loc=LOC_REFERENCE then
-                       begin
-                         paraloc^.reference.index:=NR_FRAME_POINTER_REG;
-                         inc(paraloc^.reference.offset,4);
-                       end;
-                   end;
-                 dec(paralen,tcgsize2size[paraloc^.size]);
-               end;
-             { hack to swap doubles in int registers }
-             if is_double(hp.vartype.def) and (paracgsize=OS_64) and
-               (hp.paraloc[side].location^.loc=LOC_REGISTER) then
-               begin
-                 paraloc:=hp.paraloc[side].location;
-                 hp.paraloc[side].location:=hp.paraloc[side].location^.next;
-                 hp.paraloc[side].location^.next:=paraloc;
-                 paraloc^.next:=nil;
-               end;
-          end;
-        curintreg:=nextintreg;
-        curfloatreg:=nextfloatreg;
-        curmmreg:=nextmmreg;
-        cur_stack_offset:=stack_offset;
-        result:=cur_stack_offset;
-      end;
-
-
-    function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
-      var
-        cur_stack_offset: aword;
-        curintreg, curfloatreg, curmmreg: tsuperregister;
-        retcgsize  : tcgsize;
-      begin
-        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
-
-        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
-
-        { Constructors return self instead of a boolean }
-        if (p.proctypeoption=potype_constructor) then
-          retcgsize:=OS_ADDR
-        else
-          retcgsize:=def_cgsize(p.rettype.def);
-
-        location_reset(p.funcretloc[side],LOC_INVALID,OS_NO);
-        p.funcretloc[side].size:=retcgsize;
-
-        { void has no location }
-        if is_void(p.rettype.def) then
-          begin
-            location_reset(p.funcretloc[side],LOC_VOID,OS_NO);
-            exit;
-          end;
-
-        { Return in FPU register? }
-        if p.rettype.def.deftype=floatdef then
-          begin
-            if (p.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or (cs_fp_emulation in aktmoduleswitches) then
-              begin
-                case retcgsize of
-                  OS_64,
-                  OS_F64:
-                    begin
-                      { low }
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_HIGH_REG;
-                      p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_LOW_REG;
-                      p.funcretloc[side].size:=OS_64;
-                    end;
-                  OS_32,
-                  OS_F32:
-                    begin
-                      p.funcretloc[side].loc:=LOC_REGISTER;
-                      p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
-                      p.funcretloc[side].size:=OS_32;
-                    end;
-                  else
-                    internalerror(2005082603);
-                end;
-              end
-            else
-              begin
-                p.funcretloc[side].loc:=LOC_FPUREGISTER;
-                p.funcretloc[side].register:=NR_FPU_RESULT_REG;
-              end;
-          end
-          { Return in register? }
-        else if not ret_in_param(p.rettype.def,p.proccalloption) then
-          begin
-            if retcgsize in [OS_64,OS_S64] then
-              begin
-                { low }
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register64.reglo:=NR_FUNCTION_RESULT64_LOW_REG;
-                p.funcretloc[side].register64.reghi:=NR_FUNCTION_RESULT64_HIGH_REG;
-              end
-            else
-              begin
-                p.funcretloc[side].loc:=LOC_REGISTER;
-                p.funcretloc[side].register:=NR_FUNCTION_RETURN_REG;
-              end;
-          end
-        else
-          begin
-            p.funcretloc[side].loc:=LOC_REFERENCE;
-            p.funcretloc[side].size:=retcgsize;
-          end;
-     end;
-
-
-    function tarmparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
-      var
-        cur_stack_offset: aword;
-        curintreg, curfloatreg, curmmreg: tsuperregister;
-      begin
-        init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
-
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
-        if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
-          { just continue loading the parameters in the registers }
-          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
-        else
-          internalerror(200410231);
-      end;
-
-begin
-   paramanager:=tarmparamanager.create;
-end.

compiler/compiler/arm/cpupi.pas

@@ -1,105 +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
-       globtype,cutils,
-       procinfo,cpuinfo,psub;
-
-    type
-       tarmprocinfo = class(tcgprocinfo)
-          floatregstart : aint;
-          // procedure handle_body_start;override;
-          // procedure after_pass1;override;
-          procedure set_first_temp_offset;override;
-          procedure allocate_push_parasize(size: longint);override;
-          function calc_stackframe_size:longint;override;
-       end;
-
-
-  implementation
-
-    uses
-       globals,systems,
-       cpubase,
-       aasmtai,
-       tgobj,
-       symconst,symsym,paramgr,
-       cgbase,
-       cgobj;
-
-    procedure tarmprocinfo.set_first_temp_offset;
-      begin
-        { We allocate enough space to save all registers because we can't determine
-          the necessary space because the used registers aren't known before
-          secondpass is run. Even worse, patching
-          the local offsets after generating the code could cause trouble because
-          "shifter" constants could change to non-"shifter" constants. This
-          is especially a problem when taking the address of a local. For now,
-          this extra memory should hurt less than generating all local contants with offsets
-          >256 as non shifter constants }
-        tg.setfirsttemp(-12-28);
-      end;
-
-
-    procedure tarmprocinfo.allocate_push_parasize(size:longint);
-      begin
-        if size>maxpushedparasize then
-          maxpushedparasize:=size;
-      end;
-
-
-    function tarmprocinfo.calc_stackframe_size:longint;
-      var
-         firstfloatreg,lastfloatreg,
-         r : byte;
-         floatsavesize : aword;
-      begin
-        maxpushedparasize:=align(maxpushedparasize,max(aktalignment.localalignmin,4));
-        firstfloatreg:=RS_NO;
-        { save floating point registers? }
-        for r:=RS_F0 to RS_F7 do
-          if r in cg.rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
-            begin
-              if firstfloatreg=RS_NO then
-                firstfloatreg:=r;
-              lastfloatreg:=r;
-            end;
-        if firstfloatreg<>RS_NO then
-          floatsavesize:=(lastfloatreg-firstfloatreg+1)*12
-        else
-          floatsavesize:=0;
-        floatsavesize:=align(floatsavesize,max(aktalignment.localalignmin,4));
-        result:=Align(tg.direction*tg.lasttemp,max(aktalignment.localalignmin,4))+maxpushedparasize+floatsavesize;
-        floatregstart:=-result+maxpushedparasize;
-      end;
-
-
-begin
-   cprocinfo:=tarmprocinfo;
-end.

compiler/compiler/arm/cpuswtch.pas

@@ -1,118 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
-
-    interprets the commandline options which are arm specific
-
-    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 cpuswtch;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  options;
-
-type
-  toptionarm=class(toption)
-    procedure interpret_proc_specific_options(const opt:string);override;
-  end;
-
-implementation
-
-uses
-  cutils,globtype,systems,globals;
-
-procedure toptionarm.interpret_proc_specific_options(const opt:string);
-var
-  more: string;
-  j: longint;
-begin
-  More:=Upper(copy(opt,3,length(opt)-2));
-  case opt[2] of
-   'O' : Begin
-           j := 3;
-           While (j <= Length(Opt)) Do
-             Begin
-               case opt[j] of
-                 '-' :
-                   begin
-                     initglobalswitches:=initglobalswitches-[cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_littlesize,
-                       cs_regvars,cs_uncertainopts];
-                     FillChar(ParaAlignment,sizeof(ParaAlignment),0);
-                   end;
-                 'a' :
-                   begin
-                     UpdateAlignmentStr(Copy(Opt,j+1,255),ParaAlignment);
-                     j:=length(Opt);
-                   end;
-                 'g' : initglobalswitches:=initglobalswitches+[cs_littlesize];
-                 'G' : initglobalswitches:=initglobalswitches-[cs_littlesize];
-                 'r' :
-                   begin
-                     initglobalswitches:=initglobalswitches+[cs_regvars];
-                     Simplify_ppu:=false;
-                   end;
-                 'u' : initglobalswitches:=initglobalswitches+[cs_uncertainopts];
-                 '1' : initglobalswitches:=initglobalswitches-[cs_fastoptimize,cs_slowoptimize]+[cs_optimize];
-                 '2' : initglobalswitches:=initglobalswitches-[cs_slowoptimize]+[cs_optimize,cs_fastoptimize];
-                 '3' : initglobalswitches:=initglobalswitches+[cs_optimize,cs_fastoptimize,cs_slowoptimize];
-{$ifdef dummy}
-                 'p' :
-                   Begin
-                     If j < Length(Opt) Then
-                       Begin
-                         Case opt[j+1] Of
-                           '1': initoptprocessor := Class386;
-                           '2': initoptprocessor := ClassP5;
-                           '3': initoptprocessor := ClassP6
-                           Else IllegalPara(Opt)
-                         End;
-                         Inc(j);
-                       End
-                     Else IllegalPara(opt)
-                   End;
-{$endif dummy}
-                 else IllegalPara(opt);
-               End;
-               Inc(j)
-             end;
-         end;
-{$ifdef dummy}
-   'R' : begin
-           if More='GAS' then
-            initasmmode:=asmmode_ppc_gas
-           else
-            if More='MOTOROLA' then
-             initasmmode:=asmmode_ppc_motorola
-           else
-            if More='DIRECT' then
-             initasmmode:=asmmode_direct
-           else
-            IllegalPara(opt);
-         end;
-{$endif dummy}
-  else
-   IllegalPara(opt);
-  end;
-end;
-
-
-initialization
-  coption:=toptionarm;
-end.

compiler/compiler/arm/cputarg.pas

@@ -1,78 +0,0 @@
-{
-    Copyright (c) 2001-2002 by Peter Vreman
-
-    Includes the arm 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}
-    {$ifndef NOTARGETWINCE}
-      ,t_win
-    {$endif}
-    {$ifndef NOTARGETGBA}
-      ,t_gba
-    {$endif}
-
-{**************************************
-             Assemblers
-**************************************}
-
-    {$ifndef NOAGARMGAS}
-      ,agarmgas
-    {$endif}
-
-      ,ogcoff
-
-{**************************************
-        Assembler Readers
-**************************************}
-
-  {$ifndef NoRaarmgas}
-       ,raarmgas
-  {$endif NoRaarmgas}
-
-{**************************************
-             Debuginfo
-**************************************}
-
-  {$ifndef NoDbgStabs}
-      ,dbgstabs
-  {$endif NoDbgStabs}
-  {$ifndef NoDbgDwarf}
-      ,dbgdwarf
-  {$endif NoDbgDwarf}
-      ;
-
-end.

compiler/compiler/arm/itcpugas.pas

@@ -1,93 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    This unit contains the ARM GAS instruction tables
-
-    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 itcpugas;
-
-{$i fpcdefs.inc}
-
-interface
-
-  uses
-    cpubase,cgbase;
-
-
-  const
-    { Standard opcode string table (for each tasmop enumeration). The
-      opcode strings should conform to the names as defined by the
-      processor manufacturer.
-    }
-    gas_op2str : op2strtable = {$i armatt.inc}
-
-    function gas_regnum_search(const s:string):Tregister;
-    function gas_regname(r:Tregister):string;
-
-
-implementation
-
-    uses
-      cutils,verbose;
-
-    const
-      gas_regname_table : array[tregisterindex] of string[7] = (
-        {$i rarmstd.inc}
-      );
-
-      gas_regname_index : array[tregisterindex] of tregisterindex = (
-        {$i rarmsri.inc}
-      );
-
-    function findreg_by_gasname(const s:string):tregisterindex;
-      var
-        i,p : tregisterindex;
-      begin
-        {Binary search.}
-        p:=0;
-        i:=regnumber_count_bsstart;
-        repeat
-          if (p+i<=high(tregisterindex)) and (gas_regname_table[gas_regname_index[p+i]]<=s) then
-            p:=p+i;
-          i:=i shr 1;
-        until i=0;
-        if gas_regname_table[gas_regname_index[p]]=s then
-          findreg_by_gasname:=gas_regname_index[p]
-        else
-          findreg_by_gasname:=0;
-      end;
-
-
-    function gas_regnum_search(const s:string):Tregister;
-      begin
-        result:=regnumber_table[findreg_by_gasname(s)];
-      end;
-
-
-    function gas_regname(r:Tregister):string;
-      var
-        p : tregisterindex;
-      begin
-        p:=findreg_by_number(r);
-        if p<>0 then
-          result:=gas_regname_table[p]
-        else
-          result:=generic_regname(r);
-      end;
-
-end.

compiler/compiler/arm/narmadd.pas

@@ -1,336 +0,0 @@
-{
-    Copyright (c) 2000-2002 by Florian Klaempfl
-
-    Code generation for add nodes on the ARM
-
-    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 narmadd;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-       node,ncgadd,cpubase;
-
-    type
-       tarmaddnode = class(tcgaddnode)
-       private
-          function  GetResFlags(unsigned:Boolean):TResFlags;
-       protected
-          procedure second_addfloat;override;
-          procedure second_cmpfloat;override;
-          procedure second_cmpordinal;override;
-          procedure second_cmpsmallset;override;
-          procedure second_cmp64bit;override;
-       end;
-
-  implementation
-
-    uses
-      globtype,systems,
-      cutils,verbose,globals,
-      symconst,symdef,paramgr,
-      aasmbase,aasmtai,aasmcpu,defutil,htypechk,
-      cgbase,cgutils,cgcpu,
-      cpuinfo,pass_1,pass_2,regvars,
-      cpupara,
-      ncon,nset,nadd,
-      ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32;
-
-{*****************************************************************************
-                               TSparcAddNode
-*****************************************************************************}
-
-    function tarmaddnode.GetResFlags(unsigned:Boolean):TResFlags;
-      begin
-        case NodeType of
-          equaln:
-            GetResFlags:=F_EQ;
-          unequaln:
-            GetResFlags:=F_NE;
-          else
-            if not(unsigned) then
-              begin
-                if nf_swaped in flags then
-                  case NodeType of
-                    ltn:
-                      GetResFlags:=F_GT;
-                    lten:
-                      GetResFlags:=F_GE;
-                    gtn:
-                      GetResFlags:=F_LT;
-                    gten:
-                      GetResFlags:=F_LE;
-                  end
-                else
-                  case NodeType of
-                    ltn:
-                      GetResFlags:=F_LT;
-                    lten:
-                      GetResFlags:=F_LE;
-                    gtn:
-                      GetResFlags:=F_GT;
-                    gten:
-                      GetResFlags:=F_GE;
-                  end;
-              end
-            else
-              begin
-                if nf_swaped in Flags then
-                  case NodeType of
-                    ltn:
-                      GetResFlags:=F_HI;
-                    lten:
-                      GetResFlags:=F_CS;
-                    gtn:
-                      GetResFlags:=F_CC;
-                    gten:
-                      GetResFlags:=F_LS;
-                  end
-                else
-                  case NodeType of
-                    ltn:
-                      GetResFlags:=F_CC;
-                    lten:
-                      GetResFlags:=F_LS;
-                    gtn:
-                      GetResFlags:=F_HI;
-                    gten:
-                      GetResFlags:=F_CS;
-                  end;
-              end;
-        end;
-      end;
-
-
-    procedure tarmaddnode.second_addfloat;
-      var
-        op : TAsmOp;
-      begin
-        case aktfputype of
-          fpu_fpa,
-          fpu_fpa10,
-          fpu_fpa11:
-            begin
-              pass_left_right;
-              if (nf_swaped in flags) then
-                swapleftright;
-
-              case nodetype of
-                addn :
-                  op:=A_ADF;
-                muln :
-                  op:=A_MUF;
-                subn :
-                  op:=A_SUF;
-                slashn :
-                  op:=A_DVF;
-                else
-                  internalerror(200308313);
-              end;
-
-              { force fpureg as location, left right doesn't matter
-                as both will be in a fpureg }
-              location_force_fpureg(exprasmlist,left.location,true);
-              location_force_fpureg(exprasmlist,right.location,(left.location.loc<>LOC_CFPUREGISTER));
-
-              location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
-              if left.location.loc<>LOC_CFPUREGISTER then
-                location.register:=left.location.register
-              else
-                location.register:=right.location.register;
-
-              exprasmlist.concat(setoppostfix(taicpu.op_reg_reg_reg(op,
-                 location.register,left.location.register,right.location.register),
-                 cgsize2fpuoppostfix[def_cgsize(resulttype.def)]));
-
-              location.loc:=LOC_FPUREGISTER;
-            end;
-          fpu_soft:
-            { this case should be handled already by pass1 }
-            internalerror(200308252);
-          else
-            internalerror(200308251);
-        end;
-      end;
-
-
-    procedure tarmaddnode.second_cmpfloat;
-      begin
-        pass_left_right;
-        if (nf_swaped in flags) then
-          swapleftright;
-
-        { force fpureg as location, left right doesn't matter
-          as both will be in a fpureg }
-        location_force_fpureg(exprasmlist,left.location,true);
-        location_force_fpureg(exprasmlist,right.location,true);
-
-        location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=getresflags(true);
-
-        if nodetype in [equaln,unequaln] then
-          exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_CMF,
-             left.location.register,right.location.register),
-             cgsize2fpuoppostfix[def_cgsize(resulttype.def)]))
-        else
-          exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE,
-             left.location.register,right.location.register),
-             cgsize2fpuoppostfix[def_cgsize(resulttype.def)]));
-
-        location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=getresflags(false);
-      end;
-
-
-    procedure tarmaddnode.second_cmpsmallset;
-      var
-        tmpreg : tregister;
-      begin
-        pass_left_right;
-
-        location_reset(location,LOC_FLAGS,OS_NO);
-
-        force_reg_left_right(false,false);
-
-        case nodetype of
-          equaln:
-            begin
-              exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register));
-              location.resflags:=F_EQ;
-            end;
-          unequaln:
-            begin
-              exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register));
-              location.resflags:=F_NE;
-            end;
-          lten,
-          gten:
-            begin
-              if (not(nf_swaped in flags) and
-                  (nodetype = lten)) or
-                 ((nf_swaped in flags) and
-                  (nodetype = gten)) then
-                swapleftright;
-              tmpreg:=cg.getintregister(exprasmlist,location.size);
-              exprasmlist.concat(taicpu.op_reg_reg_reg(A_AND,tmpreg,left.location.register,right.location.register));
-              exprasmlist.concat(taicpu.op_reg_reg(A_CMP,tmpreg,right.location.register));
-              location.resflags:=F_EQ;
-            end;
-          else
-            internalerror(2004012401);
-        end;
-      end;
-
-
-    procedure tarmaddnode.second_cmp64bit;
-      var
-        unsigned : boolean;
-        tmpreg : tregister;
-        oldnodetype : tnodetype;
-      begin
-        pass_left_right;
-        force_reg_left_right(false,false);
-
-        unsigned:=not(is_signed(left.resulttype.def)) or
-                  not(is_signed(right.resulttype.def));
-
-        { operation requiring proper N, Z and C flags ? }
-        if unsigned or (nodetype in [equaln,unequaln]) then
-          begin
-            location_reset(location,LOC_FLAGS,OS_NO);
-            location.resflags:=getresflags(unsigned);
-            exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
-            exprasmlist.concat(setcondition(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo),C_EQ));
-          end
-        else
-        { operation requiring proper N, Z and V flags ? }
-          begin
-            location_reset(location,LOC_JUMP,OS_NO);
-            exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi));
-            { the jump the sequence is a little bit hairy }
-            case nodetype of
-               ltn,gtn:
-                 begin
-                    cg.a_jmp_flags(exprasmlist,getresflags(false),truelabel);
-                    { cheat a little bit for the negative test }
-                    toggleflag(nf_swaped);
-                    cg.a_jmp_flags(exprasmlist,getresflags(false),falselabel);
-                    toggleflag(nf_swaped);
-                 end;
-               lten,gten:
-                 begin
-                    oldnodetype:=nodetype;
-                    if nodetype=lten then
-                      nodetype:=ltn
-                    else
-                      nodetype:=gtn;
-                    cg.a_jmp_flags(exprasmlist,getresflags(unsigned),truelabel);
-                    { cheat for the negative test }
-                    if nodetype=ltn then
-                      nodetype:=gtn
-                    else
-                      nodetype:=ltn;
-                    cg.a_jmp_flags(exprasmlist,getresflags(unsigned),falselabel);
-                    nodetype:=oldnodetype;
-                 end;
-            end;
-            exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo));
-            { the comparisaion of the low dword have to be
-               always unsigned!                            }
-            cg.a_jmp_flags(exprasmlist,getresflags(true),truelabel);
-            cg.a_jmp_always(exprasmlist,falselabel);
-          end;
-      end;
-
-
-    procedure tarmaddnode.second_cmpordinal;
-      var
-        unsigned : boolean;
-        tmpreg : tregister;
-        b : byte;
-      begin
-        pass_left_right;
-        force_reg_left_right(true,true);
-
-        unsigned:=not(is_signed(left.resulttype.def)) or
-                  not(is_signed(right.resulttype.def));
-
-        if right.location.loc = LOC_CONSTANT then
-          begin
-             if is_shifter_const(right.location.value,b) then
-               exprasmlist.concat(taicpu.op_reg_const(A_CMP,left.location.register,right.location.value))
-             else
-               begin
-                 tmpreg:=cg.getintregister(exprasmlist,location.size);
-                 cg.a_load_const_reg(exprasmlist,OS_INT,
-                   right.location.value,tmpreg);
-                 exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,tmpreg));
-               end;
-          end
-        else
-          exprasmlist.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register));
-
-        location_reset(location,LOC_FLAGS,OS_NO);
-        location.resflags:=getresflags(unsigned);
-      end;
-
-begin
-  caddnode:=tarmaddnode;
-end.

compiler/compiler/arm/narmcal.pas

@@ -1,50 +0,0 @@
-{
-    Copyright (c) 2002 by Florian Klaempfl
-
-    Implements the ARM specific part of call nodes
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published bymethodpointer
-    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 narmcal;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      symdef,node,ncal,ncgcal;
-
-    type
-       tarmcallnode = class(tcgcallnode)
-          // procedure push_framepointer;override;
-       end;
-
-implementation
-
-  uses
-    paramgr;
-
-(*
-  procedure tarmcallnode.push_framepointer;
-    begin
-      framepointer_paraloc:=paramanager.getintparaloc(procdefinition.proccalloption,1);
-    end;
-*)
-
-begin
-   ccallnode:=tarmcallnode;
-end.

compiler/compiler/arm/narmcnv.pas

@@ -1,265 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    Generate ARM assembler for type converting nodes
-
-    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 narmcnv;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      node,ncnv,ncgcnv,defcmp;
-
-    type
-       tarmtypeconvnode = class(tcgtypeconvnode)
-         protected
-           function first_int_to_real: tnode;override;
-         { procedure second_int_to_int;override; }
-         { procedure second_string_to_string;override; }
-         { procedure second_cstring_to_pchar;override; }
-         { procedure second_string_to_chararray;override; }
-         { procedure second_array_to_pointer;override; }
-         // function first_int_to_real: tnode; override;
-         { procedure second_pointer_to_array;override; }
-         { procedure second_chararray_to_string;override; }
-         { procedure second_char_to_string;override; }
-           procedure second_int_to_real;override;
-         // procedure second_real_to_real;override;
-         { procedure second_cord_to_pointer;override; }
-         { procedure second_proc_to_procvar;override; }
-         { procedure second_bool_to_int;override; }
-           procedure second_int_to_bool;override;
-         { procedure second_load_smallset;override;  }
-         { procedure second_ansistring_to_pchar;override; }
-         { procedure second_pchar_to_string;override; }
-         { procedure second_class_to_intf;override; }
-         { procedure second_char_to_char;override; }
-       end;
-
-implementation
-
-   uses
-      verbose,globtype,globals,systems,
-      symconst,symdef,aasmbase,aasmtai,
-      defutil,
-      cgbase,cgutils,
-      pass_1,pass_2,
-      ncon,ncal,
-      ncgutil,
-      cpubase,aasmcpu,
-      rgobj,tgobj,cgobj,cgcpu;
-
-
-{*****************************************************************************
-                             FirstTypeConv
-*****************************************************************************}
-
-    function tarmtypeconvnode.first_int_to_real: tnode;
-      var
-        fname: string[19];
-      begin
-        if cs_fp_emulation in aktmoduleswitches then
-          begin
-            if target_info.system in system_wince then
-              begin
-                { converting a 64bit integer to a float requires a helper }
-                if is_64bitint(left.resulttype.def) or
-                  is_currency(left.resulttype.def) then
-                  begin
-                    { hack to avoid double division by 10000, as it's
-                      already done by resulttypepass.resulttype_int_to_real }
-                    if is_currency(left.resulttype.def) then
-                      left.resulttype := s64inttype;
-                    if is_signed(left.resulttype.def) then
-                      fname:='I64TOD'
-                    else
-                      fname:='UI64TOD';
-                  end
-                else
-                  { other integers are supposed to be 32 bit }
-                  begin
-                    if is_signed(left.resulttype.def) then
-                      fname:='ITOD'
-                    else
-                      fname:='UTOD';
-                    firstpass(left);
-                  end;
-                result:=ccallnode.createintern(fname,ccallparanode.create(
-                  left,nil));
-                left:=nil;
-                firstpass(result);
-                exit;
-              end
-            else
-              begin
-                internalerror(2005082803);
-              end;
-          end
-        else
-          begin
-            { converting a 64bit integer to a float requires a helper }
-            if is_64bitint(left.resulttype.def) or
-              is_currency(left.resulttype.def) then
-              begin
-                { hack to avoid double division by 10000, as it's
-                  already done by resulttypepass.resulttype_int_to_real }
-                if is_currency(left.resulttype.def) then
-                  left.resulttype := s64inttype;
-                if is_signed(left.resulttype.def) then
-                  fname := 'fpc_int64_to_double'
-                else
-                  fname := 'fpc_qword_to_double';
-                result := ccallnode.createintern(fname,ccallparanode.create(
-                  left,nil));
-                left:=nil;
-                firstpass(result);
-                exit;
-              end
-            else
-              { other integers are supposed to be 32 bit }
-              begin
-                if is_signed(left.resulttype.def) then
-                  inserttypeconv(left,s32inttype)
-                else
-                  inserttypeconv(left,u32inttype);
-                firstpass(left);
-              end;
-            result := nil;
-            if registersfpu<1 then
-              registersfpu:=1;
-            expectloc:=LOC_FPUREGISTER;
-          end;
-      end;
-
-
-    procedure tarmtypeconvnode.second_int_to_real;
-      var
-        instr : taicpu;
-      begin
-        location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
-        location_force_reg(exprasmlist,left.location,OS_32,true);
-        location.register:=cg.getfpuregister(exprasmlist,location.size);
-        instr:=taicpu.op_reg_reg(A_FLT,location.register,left.location.register);
-        instr.oppostfix:=cgsize2fpuoppostfix[def_cgsize(resulttype.def)];
-        exprasmlist.concat(instr);
-      end;
-
-
-    procedure tarmtypeconvnode.second_int_to_bool;
-      var
-        hregister : tregister;
-        href      : treference;
-        resflags  : tresflags;
-        hlabel,oldtruelabel,oldfalselabel : tasmlabel;
-      begin
-         oldtruelabel:=truelabel;
-         oldfalselabel:=falselabel;
-         objectlibrary.getjumplabel(truelabel);
-         objectlibrary.getjumplabel(falselabel);
-         secondpass(left);
-         if codegenerror then
-          exit;
-         { byte(boolean) or word(wordbool) or longint(longbool) must
-           be accepted for var parameters                            }
-         if (nf_explicit in flags) and
-            (left.resulttype.def.size=resulttype.def.size) and
-            (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
-           begin
-              location_copy(location,left.location);
-              truelabel:=oldtruelabel;
-              falselabel:=oldfalselabel;
-              exit;
-           end;
-
-         { Load left node into flag F_NE/F_E }
-         resflags:=F_NE;
-         case left.location.loc of
-            LOC_CREFERENCE,
-            LOC_REFERENCE :
-              begin
-                if left.location.size in [OS_64,OS_S64] then
-                 begin
-                   hregister:=cg.getintregister(exprasmlist,OS_INT);
-                   cg.a_load_ref_reg(exprasmlist,OS_32,OS_32,left.location.reference,hregister);
-                   href:=left.location.reference;
-                   inc(href.offset,4);
-                   tcgarm(cg).cgsetflags:=true;
-                   cg.a_op_ref_reg(exprasmlist,OP_OR,OS_32,href,hregister);
-                   tcgarm(cg).cgsetflags:=false;
-                 end
-                else
-                 begin
-                   location_force_reg(exprasmlist,left.location,left.location.size,true);
-                   tcgarm(cg).cgsetflags:=true;
-                   cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register);
-                   tcgarm(cg).cgsetflags:=false;
-                 end;
-              end;
-            LOC_FLAGS :
-              begin
-                resflags:=left.location.resflags;
-              end;
-            LOC_REGISTER,LOC_CREGISTER :
-              begin
-                if left.location.size in [OS_64,OS_S64] then
-                 begin
-                   hregister:=cg.getintregister(exprasmlist,OS_32);
-                   cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,left.location.register64.reglo,hregister);
-                   tcgarm(cg).cgsetflags:=true;
-                   cg.a_op_reg_reg(exprasmlist,OP_OR,OS_32,left.location.register64.reghi,hregister);
-                   tcgarm(cg).cgsetflags:=false;
-                 end
-                else
-                 begin
-                   tcgarm(cg).cgsetflags:=true;
-                   cg.a_op_reg_reg(exprasmlist,OP_OR,left.location.size,left.location.register,left.location.register);
-                   tcgarm(cg).cgsetflags:=false;
-                 end;
-              end;
-            LOC_JUMP :
-              begin
-                hregister:=cg.getintregister(exprasmlist,OS_INT);
-                objectlibrary.getjumplabel(hlabel);
-                cg.a_label(exprasmlist,truelabel);
-                cg.a_load_const_reg(exprasmlist,OS_INT,1,hregister);
-                cg.a_jmp_always(exprasmlist,hlabel);
-                cg.a_label(exprasmlist,falselabel);
-                cg.a_load_const_reg(exprasmlist,OS_INT,0,hregister);
-                cg.a_label(exprasmlist,hlabel);
-                tcgarm(cg).cgsetflags:=true;
-                cg.a_op_reg_reg(exprasmlist,OP_OR,OS_INT,hregister,hregister);
-                tcgarm(cg).cgsetflags:=false;
-              end;
-            else
-              internalerror(200311301);
-         end;
-         { load flags to register }
-         location_reset(location,LOC_REGISTER,def_cgsize(resulttype.def));
-         location.register:=cg.getintregister(exprasmlist,location.size);
-         cg.g_flags2reg(exprasmlist,location.size,resflags,location.register);
-         truelabel:=oldtruelabel;
-         falselabel:=oldfalselabel;
-      end;
-
-
-begin
-  ctypeconvnode:=tarmtypeconvnode;
-end.

compiler/compiler/arm/narmcon.pas

@@ -1,141 +0,0 @@
-{
-    Copyright (c) 2005 by Florian Klaempfl
-
-    Code generation for const nodes on the ARM
-
-    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 narmcon;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      node,ncgcon,cpubase;
-
-    type
-      tarmrealconstnode = class(tcgrealconstnode)
-        procedure pass_2;override;
-      end;
-
-  implementation
-
-    uses
-      verbose,
-      globtype,globals,
-      cpuinfo,
-      aasmbase,aasmtai,
-      symconst,symdef,
-      defutil,
-      cgbase,cgutils,
-      procinfo,
-      ncon;
-
-{*****************************************************************************
-                           TARMREALCONSTNODE
-*****************************************************************************}
-
-    procedure tarmrealconstnode.pass_2;
-      { I suppose the parser/pass_1 must make sure the generated real  }
-      { constants are actually supported by the target processor? (JM) }
-      const
-        floattype2ait:array[tfloattype] of taitype=
-          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit);
-      var
-         hp1 : tai;
-         lastlabel : tasmlabel;
-         realait : taitype;
-         hiloswapped : boolean;
-
-      begin
-        location_reset(location,LOC_CREFERENCE,def_cgsize(resulttype.def));
-        lastlabel:=nil;
-        realait:=floattype2ait[tfloatdef(resulttype.def).typ];
-        hiloswapped:=aktfputype in [fpu_fpa,fpu_fpa10,fpu_fpa11];
-        { const already used ? }
-        if not assigned(lab_real) then
-          begin
-            objectlibrary.getjumplabel(lastlabel);
-            lab_real:=lastlabel;
-            current_procinfo.aktlocaldata.concat(Tai_label.Create(lastlabel));
-            location.reference.symboldata:=current_procinfo.aktlocaldata.last;
-            case realait of
-              ait_real_32bit :
-                begin
-                  current_procinfo.aktlocaldata.concat(Tai_real_32bit.Create(ts32real(value_real)));
-                  { range checking? }
-                  if ((cs_check_range in aktlocalswitches) or
-                    (cs_check_overflow in aktlocalswitches)) and
-                    (tai_real_32bit(asmlist[al_typedconsts].last).value=double(MathInf)) then
-                    Message(parser_e_range_check_error);
-                end;
-
-              ait_real_64bit :
-                begin
-                  if hiloswapped then
-                    current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real)))
-                  else
-                    current_procinfo.aktlocaldata.concat(Tai_real_64bit.Create(ts64real(value_real)));
-
-                  { range checking? }
-                  if ((cs_check_range in aktlocalswitches) or
-                    (cs_check_overflow in aktlocalswitches)) and
-                    (tai_real_64bit(asmlist[al_typedconsts].last).value=double(MathInf)) then
-                    Message(parser_e_range_check_error);
-               end;
-
-              ait_real_80bit :
-                begin
-                  current_procinfo.aktlocaldata.concat(Tai_real_80bit.Create(value_real));
-
-                  { range checking? }
-                  if ((cs_check_range in aktlocalswitches) or
-                    (cs_check_overflow in aktlocalswitches)) and
-                    (tai_real_80bit(asmlist[al_typedconsts].last).value=double(MathInf)) then
-                    Message(parser_e_range_check_error);
-                end;
-{$ifdef cpufloat128}
-              ait_real_128bit :
-                begin
-                  current_procinfo.aktlocaldata.concat(Tai_real_128bit.Create(value_real));
-
-                  { range checking? }
-                  if ((cs_check_range in aktlocalswitches) or
-                    (cs_check_overflow in aktlocalswitches)) and
-                    (tai_real_128bit(asmlist[al_typedconsts].last).value=double(MathInf)) then
-                    Message(parser_e_range_check_error);
-                end;
-{$endif cpufloat128}
-
-              { the round is necessary for native compilers where comp isn't a float }
-              ait_comp_64bit :
-                if (value_real>9223372036854775807.0) or (value_real<-9223372036854775808.0) then
-                  message(parser_e_range_check_error)
-                else
-                  current_procinfo.aktlocaldata.concat(Tai_comp_64bit.Create(round(value_real)));
-            else
-              internalerror(2005092401);
-            end;
-          end;
-        location.reference.symbol:=lab_real;
-        location.reference.base:=NR_R15;
-      end;
-
-begin
-  crealconstnode:=tarmrealconstnode;
-end.

compiler/compiler/arm/narminl.pas

@@ -1,216 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    Generates ARM inline nodes
-
-    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 narminl;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      node,ninl,ncginl;
-
-    type
-      tarminlinenode = class(tcgInlineNode)
-        function first_abs_real: tnode; override;
-        function first_sqr_real: tnode; override;
-        function first_sqrt_real: tnode; override;
-        { atn,sin,cos,lgn isn't supported by the linux fpe
-        function first_arctan_real: tnode; override;
-        function first_ln_real: tnode; override;
-        function first_cos_real: tnode; override;
-        function first_sin_real: tnode; override;
-        }
-        procedure second_abs_real; override;
-        procedure second_sqr_real; override;
-        procedure second_sqrt_real; override;
-        { atn,sin,cos,lgn isn't supported by the linux fpe
-        procedure second_arctan_real; override;
-        procedure second_ln_real; override;
-        procedure second_cos_real; override;
-        procedure second_sin_real; override;
-        }
-      private
-        procedure load_fpu_location;
-      end;
-
-
-implementation
-
-    uses
-      globtype,systems,
-      cutils,verbose,globals,fmodule,
-      symconst,symdef,
-      aasmbase,aasmtai,aasmcpu,
-      cgbase,cgutils,
-      pass_1,pass_2,
-      cpubase,paramgr,
-      nbas,ncon,ncal,ncnv,nld,
-      tgobj,ncgutil,cgobj,cg64f32,rgobj,rgcpu,cgcpu;
-
-{*****************************************************************************
-                              tarminlinenode
-*****************************************************************************}
-
-    procedure tarminlinenode.load_fpu_location;
-      begin
-        secondpass(left);
-        location_force_fpureg(exprasmlist,left.location,true);
-        location_copy(location,left.location);
-        if left.location.loc=LOC_CFPUREGISTER then
-          begin
-           location.register:=cg.getfpuregister(exprasmlist,location.size);
-           location.loc := LOC_FPUREGISTER;
-         end;
-      end;
-
-
-    function tarminlinenode.first_abs_real : tnode;
-      begin
-        if cs_fp_emulation in aktmoduleswitches then
-          result:=inherited first_abs_real
-        else
-          begin
-            expectloc:=LOC_FPUREGISTER;
-            registersint:=left.registersint;
-            registersfpu:=max(left.registersfpu,1);
-            first_abs_real:=nil;
-          end;
-      end;
-
-
-    function tarminlinenode.first_sqr_real : tnode;
-      begin
-        if cs_fp_emulation in aktmoduleswitches then
-          result:=inherited first_sqr_real
-        else
-          begin
-            expectloc:=LOC_FPUREGISTER;
-            registersint:=left.registersint;
-            registersfpu:=max(left.registersfpu,1);
-            first_sqr_real:=nil;
-          end;
-      end;
-
-
-    function tarminlinenode.first_sqrt_real : tnode;
-      begin
-        if cs_fp_emulation in aktmoduleswitches then
-          result:=inherited first_sqrt_real
-        else
-          begin
-            expectloc:=LOC_FPUREGISTER;
-            registersint:=left.registersint;
-                    registersfpu:=max(left.registersfpu,1);
-            first_sqrt_real := nil;
-          end;
-      end;
-
-
-    { atn,sin,cos,lgn isn't supported by the linux fpe
-    function tarminlinenode.first_arctan_real: tnode;
-      begin
-        expectloc:=LOC_FPUREGISTER;
-        registersint:=left.registersint;
-        registersfpu:=max(left.registersfpu,1);
-        result:=nil;
-      end;
-
-
-    function tarminlinenode.first_ln_real: tnode;
-      begin
-        expectloc:=LOC_FPUREGISTER;
-        registersint:=left.registersint;
-        registersfpu:=max(left.registersfpu,1);
-        result:=nil;
-      end;
-
-    function tarminlinenode.first_cos_real: tnode;
-      begin
-        expectloc:=LOC_FPUREGISTER;
-        registersint:=left.registersint;
-        registersfpu:=max(left.registersfpu,1);
-        result:=nil;
-      end;
-
-
-    function tarminlinenode.first_sin_real: tnode;
-      begin
-        expectloc:=LOC_FPUREGISTER;
-        registersint:=left.registersint;
-        registersfpu:=max(left.registersfpu,1);
-        result:=nil;
-      end;
-    }
-
-
-    procedure tarminlinenode.second_abs_real;
-      begin
-        load_fpu_location;
-        exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_ABS,location.register,location.register),get_fpu_postfix(resulttype.def)));
-      end;
-
-
-    procedure tarminlinenode.second_sqr_real;
-      begin
-        load_fpu_location;
-        exprasmlist.concat(setoppostfix(taicpu.op_reg_reg_reg(A_MUF,location.register,left.location.register,left.location.register),get_fpu_postfix(resulttype.def)));
-      end;
-
-
-    procedure tarminlinenode.second_sqrt_real;
-      begin
-        load_fpu_location;
-        exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_SQT,location.register,location.register),get_fpu_postfix(resulttype.def)));
-      end;
-
-
-    { atn, sin, cos, lgn isn't supported by the linux fpe
-    procedure tarminlinenode.second_arctan_real;
-      begin
-        load_fpu_location;
-        exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_ATN,location.register,location.register),get_fpu_postfix(resulttype.def)));
-      end;
-
-
-    procedure tarminlinenode.second_ln_real;
-      begin
-        load_fpu_location;
-        exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_LGN,location.register,location.register),get_fpu_postfix(resulttype.def)));
-      end;
-
-    procedure tarminlinenode.second_cos_real;
-      begin
-        load_fpu_location;
-        exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_COS,location.register,location.register),get_fpu_postfix(resulttype.def)));
-      end;
-
-
-    procedure tarminlinenode.second_sin_real;
-      begin
-        load_fpu_location;
-        exprasmlist.concat(setoppostfix(taicpu.op_reg_reg(A_SIN,location.register,location.register),get_fpu_postfix(resulttype.def)));
-      end;
-    }
-
-begin
-  cinlinenode:=tarminlinenode;
-end.

compiler/compiler/arm/narmmat.pas

@@ -1,121 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    Generate ARM assembler for math nodes
-
-    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 narmmat;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      node,nmat,ncgmat;
-
-    type
-      tarmnotnode = class(tcgnotnode)
-        procedure second_boolean;override;
-      end;
-
-
-      tarmunaryminusnode = class(tcgunaryminusnode)
-        procedure second_float;override;
-      end;
-
-
-implementation
-
-    uses
-      globtype,systems,
-      cutils,verbose,globals,
-      symconst,symdef,
-      aasmbase,aasmcpu,aasmtai,
-      defutil,
-      cgbase,cgobj,cgutils,
-      pass_1,pass_2,
-      ncon,
-      cpubase,cpuinfo,
-      ncgutil,cgcpu,cg64f32,rgobj;
-
-{*****************************************************************************
-                               TARMNOTNODE
-*****************************************************************************}
-
-    procedure tarmnotnode.second_boolean;
-      var
-        hl : tasmlabel;
-        ins : taicpu;
-      begin
-        { if the location is LOC_JUMP, we do the secondpass after the
-          labels are allocated
-        }
-        if left.expectloc=LOC_JUMP then
-          begin
-            hl:=truelabel;
-            truelabel:=falselabel;
-            falselabel:=hl;
-            secondpass(left);
-            maketojumpbool(exprasmlist,left,lr_load_regvars);
-            hl:=truelabel;
-            truelabel:=falselabel;
-            falselabel:=hl;
-            location.loc:=LOC_JUMP;
-          end
-        else
-          begin
-            secondpass(left);
-            case left.location.loc of
-              LOC_FLAGS :
-                begin
-                  location_copy(location,left.location);
-                  inverse_flags(location.resflags);
-                end;
-              LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE :
-                begin
-                  location_force_reg(exprasmlist,left.location,def_cgsize(left.resulttype.def),true);
-                  exprasmlist.concat(taicpu.op_reg_const(A_CMP,left.location.register,0));
-                  location_reset(location,LOC_FLAGS,OS_NO);
-                  location.resflags:=F_EQ;
-               end;
-              else
-                internalerror(2003042401);
-            end;
-          end;
-      end;
-
-{*****************************************************************************
-                               TARMUNARYMINUSNODE
-*****************************************************************************}
-
-    procedure tarmunaryminusnode.second_float;
-      begin
-        secondpass(left);
-        location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
-        location_force_fpureg(exprasmlist,left.location,false);
-        location:=left.location;
-        exprasmlist.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSF,
-          location.register,left.location.register,0),
-          cgsize2fpuoppostfix[def_cgsize(resulttype.def)]));
-      end;
-
-
-begin
-   cnotnode:=tarmnotnode;
-   cunaryminusnode:=tarmunaryminusnode;
-end.

compiler/compiler/arm/raarm.pas

@@ -1,54 +0,0 @@
-{
-    Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman
-
-    Handles the common arm assembler reader routines
-
-    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 raarm;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-      cpubase,
-      aasmtai,
-      rautils;
-
-    type
-      TARMOperand=class(TOperand)
-      end;
-
-      TARMInstruction=class(TInstruction)
-        oppostfix : toppostfix;
-        function ConcatInstruction(p:TAAsmoutput) : tai;override;
-      end;
-
-  implementation
-
-    uses
-      aasmcpu;
-
-    function TARMInstruction.ConcatInstruction(p:TAAsmoutput) : tai;
-      begin
-        result:=inherited ConcatInstruction(p);
-        (result as taicpu).oppostfix:=oppostfix;
-      end;
-
-
-end.

compiler/compiler/arm/raarmgas.pas

@@ -1,797 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
-
-    Does the parsing for the ARM GNU AS styled 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.
-
- ****************************************************************************
-}
-Unit raarmgas;
-
-{$i fpcdefs.inc}
-
-  Interface
-
-    uses
-      raatt,raarm,
-      cpubase;
-
-    type
-      tarmattreader = class(tattreader)
-        actoppostfix : TOpPostfix;
-        function is_asmopcode(const s: string):boolean;override;
-        function is_register(const s:string):boolean;override;
-        procedure handleopcode;override;
-        procedure BuildReference(oper : tarmoperand);
-        procedure BuildOperand(oper : tarmoperand);
-        function TryBuildShifterOp(oper : tarmoperand) : boolean;
-        procedure BuildOpCode(instr : tarminstruction);
-        procedure ReadSym(oper : tarmoperand);
-        procedure ConvertCalljmp(instr : tarminstruction);
-      end;
-
-
-  Implementation
-
-    uses
-      { helpers }
-      cutils,
-      { global }
-      globtype,globals,verbose,
-      systems,
-      { aasm }
-      cpuinfo,aasmbase,aasmtai,aasmcpu,
-      { symtable }
-      symconst,symbase,symtype,symsym,symtable,
-      { parser }
-      scanner,
-      procinfo,
-      itcpugas,
-      rabase,rautils,
-      cgbase,cgobj
-      ;
-
-
-    function tarmattreader.is_register(const s:string):boolean;
-      type
-        treg2str = record
-          name : string[2];
-          reg : tregister;
-        end;
-
-      const
-        extraregs : array[0..19] of treg2str = (
-          (name: 'A1'; reg : NR_R0),
-          (name: 'A2'; reg : NR_R1),
-          (name: 'A3'; reg : NR_R2),
-          (name: 'A4'; reg : NR_R3),
-          (name: 'V1'; reg : NR_R4),
-          (name: 'V2'; reg : NR_R5),
-          (name: 'V3'; reg : NR_R6),
-          (name: 'V4'; reg : NR_R7),
-          (name: 'V5'; reg : NR_R8),
-          (name: 'V6'; reg : NR_R9),
-          (name: 'V7'; reg : NR_R10),
-          (name: 'V8'; reg : NR_R11),
-          (name: 'WR'; reg : NR_R7),
-          (name: 'SB'; reg : NR_R9),
-          (name: 'SL'; reg : NR_R10),
-          (name: 'FP'; reg : NR_R11),
-          (name: 'IP'; reg : NR_R12),
-          (name: 'SP'; reg : NR_R13),
-          (name: 'LR'; reg : NR_R14),
-          (name: 'PC'; reg : NR_R15));
-
-      var
-        i : longint;
-
-      begin
-        result:=inherited is_register(s);
-        { reg found?
-          possible aliases are always 2 char
-        }
-        if result or (length(s)<>2) then
-          exit;
-        for i:=low(extraregs) to high(extraregs) do
-          begin
-            if s=extraregs[i].name then
-              begin
-                actasmregister:=extraregs[i].reg;
-                result:=true;
-                actasmtoken:=AS_REGISTER;
-                exit;
-              end;
-          end;
-      end;
-
-
-    procedure tarmattreader.ReadSym(oper : tarmoperand);
-      var
-         tempstr : string;
-         typesize,l,k : longint;
-      begin
-        tempstr:=actasmpattern;
-        Consume(AS_ID);
-        { typecasting? }
-        if (actasmtoken=AS_LPAREN) and
-           SearchType(tempstr,typesize) then
-         begin
-           oper.hastype:=true;
-           Consume(AS_LPAREN);
-           BuildOperand(oper);
-           Consume(AS_RPAREN);
-           if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-             oper.SetSize(typesize,true);
-         end
-        else
-         if not oper.SetupVar(tempstr,false) then
-          Message1(sym_e_unknown_id,tempstr);
-        { record.field ? }
-        if actasmtoken=AS_DOT then
-         begin
-           BuildRecordOffsetSize(tempstr,l,k);
-           inc(oper.opr.ref.offset,l);
-         end;
-      end;
-
-
-    Procedure tarmattreader.BuildReference(oper : tarmoperand);
-
-      procedure Consume_RBracket;
-        begin
-          if actasmtoken<>AS_RBRACKET then
-           Begin
-             Message(asmr_e_invalid_reference_syntax);
-             RecoverConsume(true);
-           end
-          else
-           begin
-             Consume(AS_RBRACKET);
-             if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then
-              Begin
-                Message(asmr_e_invalid_reference_syntax);
-                RecoverConsume(true);
-              end;
-           end;
-        end;
-
-
-      procedure read_index;
-        begin
-          Consume(AS_COMMA);
-          if actasmtoken=AS_REGISTER then
-            Begin
-              oper.opr.ref.index:=actasmregister;
-              Consume(AS_REGISTER);
-            end
-          else if actasmtoken=AS_HASH then
-            begin
-              Consume(AS_HASH);
-              inc(oper.opr.ref.offset,BuildConstExpression(false,true));
-            end;
-        end;
-
-
-      begin
-        Consume(AS_LBRACKET);
-        if actasmtoken=AS_REGISTER then
-          begin
-            oper.opr.ref.base:=actasmregister;
-            Consume(AS_REGISTER);
-            { can either be a register or a right parenthesis }
-            { (reg)        }
-            if actasmtoken=AS_RBRACKET then
-             Begin
-               Consume_RBracket;
-               oper.opr.ref.addressmode:=AM_POSTINDEXED;
-               if actasmtoken=AS_COMMA then
-                 read_index;
-               exit;
-             end;
-            if actasmtoken=AS_COMMA then
-              begin
-                read_index;
-                Consume_RBracket;
-              end;
-            if actasmtoken=AS_NOT then
-              begin
-                consume(AS_NOT);
-                oper.opr.ref.addressmode:=AM_PREINDEXED;
-              end;
-          end {end case }
-        else
-          Begin
-            Message(asmr_e_invalid_reference_syntax);
-            RecoverConsume(false);
-          end;
-      end;
-
-
-    function tarmattreader.TryBuildShifterOp(oper : tarmoperand) : boolean;
-
-      procedure handlepara(sm : tshiftmode);
-        begin
-          consume(AS_ID);
-          fillchar(oper.opr,sizeof(oper.opr),0);
-          oper.opr.typ:=OPR_SHIFTEROP;
-          oper.opr.shifterop.shiftmode:=sm;
-          if sm<>SM_RRX then
-            begin
-              case actasmtoken of
-                AS_REGISTER:
-                  begin
-                    oper.opr.shifterop.rs:=actasmregister;
-                    consume(AS_REGISTER);
-                  end;
-                AS_HASH:
-                  begin
-                    consume(AS_HASH);
-                    oper.opr.shifterop.shiftimm:=BuildConstExpression(false,false);
-                  end;
-                else
-                  Message(asmr_e_illegal_shifterop_syntax);
-              end;
-            end;
-        end;
-
-      begin
-        result:=true;
-        if (actasmtoken=AS_ID) then
-          begin
-            if (actasmpattern='LSL') then
-              handlepara(SM_LSL)
-            else if (actasmpattern='LSR') then
-              handlepara(SM_LSR)
-            else if (actasmpattern='ASR') then
-              handlepara(SM_ASR)
-            else if (actasmpattern='ROR') then
-              handlepara(SM_ROR)
-            else if (actasmpattern='RRX') then
-              handlepara(SM_ROR)
-            else
-              result:=false;
-          end
-        else
-          result:=false;
-      end;
-
-
-    Procedure tarmattreader.BuildOperand(oper : tarmoperand);
-      var
-        expr : string;
-        typesize,l : longint;
-
-
-        procedure AddLabelOperand(hl:tasmlabel);
-          begin
-            if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and
-               is_calljmp(actopcode) then
-             begin
-               oper.opr.typ:=OPR_SYMBOL;
-               oper.opr.symbol:=hl;
-             end
-            else
-             begin
-               oper.InitRef;
-               oper.opr.ref.symbol:=hl;
-             end;
-          end;
-
-
-        procedure MaybeRecordOffset;
-          var
-            hasdot  : boolean;
-            l,
-            toffset,
-            tsize   : longint;
-          begin
-            if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
-             exit;
-            l:=0;
-            hasdot:=(actasmtoken=AS_DOT);
-            if hasdot then
-              begin
-                if expr<>'' then
-                  begin
-                    BuildRecordOffsetSize(expr,toffset,tsize);
-                    inc(l,toffset);
-                    oper.SetSize(tsize,true);
-                  end;
-              end;
-            if actasmtoken in [AS_PLUS,AS_MINUS] then
-              inc(l,BuildConstExpression(true,false));
-            case oper.opr.typ of
-              OPR_LOCAL :
-                begin
-                  { don't allow direct access to fields of parameters, because that
-                    will generate buggy code. Allow it only for explicit typecasting }
-                  if hasdot and
-                     (not oper.hastype) and
-                     (tabstractnormalvarsym(oper.opr.localsym).owner.symtabletype=parasymtable) and
-                     (current_procinfo.procdef.proccalloption<>pocall_register) then
-                    Message(asmr_e_cannot_access_field_directly_for_parameters);
-                  inc(oper.opr.localsymofs,l)
-                end;
-              OPR_CONSTANT :
-                inc(oper.opr.val,l);
-              OPR_REFERENCE :
-                inc(oper.opr.ref.offset,l);
-              else
-                internalerror(200309221);
-            end;
-          end;
-
-
-        function MaybeBuildReference:boolean;
-          { Try to create a reference, if not a reference is found then false
-            is returned }
-          begin
-            MaybeBuildReference:=true;
-            case actasmtoken of
-              AS_INTNUM,
-              AS_MINUS,
-              AS_PLUS:
-                Begin
-                  oper.opr.ref.offset:=BuildConstExpression(True,False);
-                  if actasmtoken<>AS_LPAREN then
-                    Message(asmr_e_invalid_reference_syntax)
-                  else
-                    BuildReference(oper);
-                end;
-              AS_LPAREN:
-                BuildReference(oper);
-              AS_ID: { only a variable is allowed ... }
-                Begin
-                  ReadSym(oper);
-                  case actasmtoken of
-                    AS_END,
-                    AS_SEPARATOR,
-                    AS_COMMA: ;
-                    AS_LPAREN:
-                      BuildReference(oper);
-                  else
-                    Begin
-                      Message(asmr_e_invalid_reference_syntax);
-                      Consume(actasmtoken);
-                    end;
-                  end; {end case }
-                end;
-              else
-               MaybeBuildReference:=false;
-            end; { end case }
-          end;
-
-
-      var
-        tempreg : tregister;
-        ireg : tsuperregister;
-        hl : tasmlabel;
-        ofs : longint;
-        registerset : tcpuregisterset;
-      Begin
-        expr:='';
-        case actasmtoken of
-          AS_LBRACKET: { Memory reference or constant expression }
-            Begin
-              oper.InitRef;
-              BuildReference(oper);
-            end;
-
-          AS_HASH: { Constant expression  }
-            Begin
-              Consume(AS_HASH);
-              BuildConstantOperand(oper);
-            end;
-
-          (*
-          AS_INTNUM,
-          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_LPAREN then
-                begin
-                  ofs:=oper.opr.ref.offset;
-                  BuildConstantOperand(oper);
-                  inc(oper.opr.val,ofs);
-                end
-              else
-                BuildReference(oper);
-            end;
-          *)
-          AS_ID: { A constant expression, or a Variable ref.  }
-            Begin
-              { Local Label ? }
-              if is_locallabel(actasmpattern) then
-               begin
-                 CreateLocalLabel(actasmpattern,hl,false);
-                 Consume(AS_ID);
-                 AddLabelOperand(hl);
-               end
-              else
-               { Check for label }
-               if SearchLabel(actasmpattern,hl,false) then
-                begin
-                  Consume(AS_ID);
-                  AddLabelOperand(hl);
-                end
-              else
-               { probably a variable or normal expression }
-               { or a procedure (such as in CALL ID)      }
-               Begin
-                 { is it a constant ? }
-                 if SearchIConstant(actasmpattern,l) then
-                  Begin
-                    if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
-                     Message(asmr_e_invalid_operand_type);
-                    BuildConstantOperand(oper);
-                  end
-                 else
-                  begin
-                    expr:=actasmpattern;
-                    Consume(AS_ID);
-                    { typecasting? }
-                    if (actasmtoken=AS_LPAREN) and
-                       SearchType(expr,typesize) then
-                     begin
-                       oper.hastype:=true;
-                       Consume(AS_LPAREN);
-                       BuildOperand(oper);
-                       Consume(AS_RPAREN);
-                       if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then
-                         oper.SetSize(typesize,true);
-                     end
-                    else
-                     begin
-                       if not(oper.SetupVar(expr,false)) then
-                        Begin
-                          { look for special symbols ... }
-                          if expr= '__HIGH' then
-                            begin
-                              consume(AS_LPAREN);
-                              if not oper.setupvar('high'+actasmpattern,false) then
-                                Message1(sym_e_unknown_id,'high'+actasmpattern);
-                              consume(AS_ID);
-                              consume(AS_RPAREN);
-                            end
-                          else
-                           if expr = '__RESULT' then
-                            oper.SetUpResult
-                          else
-                           if expr = '__SELF' then
-                            oper.SetupSelf
-                          else
-                           if expr = '__OLDEBP' then
-                            oper.SetupOldEBP
-                          else
-                            Message1(sym_e_unknown_id,expr);
-                        end;
-                     end;
-                  end;
-                  if actasmtoken=AS_DOT then
-                    MaybeRecordOffset;
-                  { add a constant expression? }
-                  if (actasmtoken=AS_PLUS) then
-                   begin
-                     l:=BuildConstExpression(true,false);
-                     case oper.opr.typ of
-                       OPR_CONSTANT :
-                         inc(oper.opr.val,l);
-                       OPR_LOCAL :
-                         inc(oper.opr.localsymofs,l);
-                       OPR_REFERENCE :
-                         inc(oper.opr.ref.offset,l);
-                       else
-                         internalerror(200309202);
-                     end;
-                   end
-               end;
-              { Do we have a indexing reference, then parse it also }
-              if actasmtoken=AS_LPAREN then
-                BuildReference(oper);
-            end;
-
-          { Register, a variable reference or a constant reference  }
-          AS_REGISTER:
-            Begin
-              { save the type of register used. }
-              tempreg:=actasmregister;
-              Consume(AS_REGISTER);
-              if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then
-                Begin
-                  if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then
-                    Message(asmr_e_invalid_operand_type);
-                  oper.opr.typ:=OPR_REGISTER;
-                  oper.opr.reg:=tempreg;
-                end
-              else if (actasmtoken=AS_NOT) and (actopcode in [A_LDM,A_STM]) then
-                begin
-                  consume(AS_NOT);
-                  oper.opr.typ:=OPR_REFERENCE;
-                  oper.opr.ref.addressmode:=AM_PREINDEXED;
-                  oper.opr.ref.index:=tempreg;
-                end
-              else
-                Message(asmr_e_syn_operand);
-            end;
-
-          { Registerset }
-          AS_LSBRACKET:
-            begin
-              consume(AS_LSBRACKET);
-              registerset:=[];
-              while true do
-                begin
-                  if actasmtoken=AS_REGISTER then
-                    begin
-                      include(registerset,getsupreg(actasmregister));
-                      tempreg:=actasmregister;
-                      consume(AS_REGISTER);
-                      if actasmtoken=AS_MINUS then
-                        begin
-                          consume(AS_MINUS);
-                          for ireg:=getsupreg(tempreg) to getsupreg(actasmregister) do
-                            include(registerset,ireg);
-                          consume(AS_REGISTER);
-                        end;
-                    end
-                  else
-                    consume(AS_REGISTER);
-                  if actasmtoken=AS_COMMA then
-                    consume(AS_COMMA)
-                  else
-                    break;
-                end;
-              consume(AS_RSBRACKET);
-              oper.opr.typ:=OPR_REGSET;
-              oper.opr.regset:=registerset;
-            end;
-          AS_END,
-          AS_SEPARATOR,
-          AS_COMMA: ;
-        else
-          Begin
-            Message(asmr_e_syn_operand);
-            Consume(actasmtoken);
-          end;
-        end; { end case }
-      end;
-
-
-{*****************************************************************************
-                                tarmattreader
-*****************************************************************************}
-
-    procedure tarmattreader.BuildOpCode(instr : tarminstruction);
-      var
-        operandnum : longint;
-      Begin
-        { opcode }
-        if (actasmtoken<>AS_OPCODE) then
-         Begin
-           Message(asmr_e_invalid_or_missing_opcode);
-           RecoverConsume(true);
-           exit;
-         end;
-        { Fill the instr object with the current state }
-        with instr do
-          begin
-            Opcode:=ActOpcode;
-            condition:=ActCondition;
-            oppostfix:=actoppostfix;
-          end;
-
-        { We are reading operands, so opcode will be an AS_ID }
-        operandnum:=1;
-        Consume(AS_OPCODE);
-        { Zero operand opcode ?  }
-        if actasmtoken in [AS_SEPARATOR,AS_END] then
-         begin
-           operandnum:=0;
-           exit;
-         end;
-        { Read the operands }
-        repeat
-          case actasmtoken of
-            AS_COMMA: { Operand delimiter }
-              Begin
-                if ((instr.opcode=A_MOV) and (operandnum=2)) or
-                  ((operandnum=3) and not(instr.opcode in [A_UMLAL,A_UMULL,A_SMLAL,A_SMULL])) then
-                  begin
-                    Consume(AS_COMMA);
-                    if not(TryBuildShifterOp(instr.Operands[4] as tarmoperand)) then
-                      Message(asmr_e_illegal_shifterop_syntax);
-                    Inc(operandnum);
-                  end
-                else
-                  begin
-                    if operandnum>Max_Operands then
-                      Message(asmr_e_too_many_operands)
-                    else
-                      Inc(operandnum);
-                    Consume(AS_COMMA);
-                  end;
-              end;
-            AS_SEPARATOR,
-            AS_END : { End of asm operands for this opcode  }
-              begin
-                break;
-              end;
-          else
-            BuildOperand(instr.Operands[operandnum] as tarmoperand);
-          end; { end case }
-        until false;
-        instr.Ops:=operandnum;
-      end;
-
-
-    function tarmattreader.is_asmopcode(const s: string):boolean;
-
-      const
-        { sorted by length so longer postfixes will match first }
-        postfix2strsorted : array[1..19] of string[2] = (
-          'EP','SB','BT','SH',
-          'IA','IB','DA','DB','FD','FA','ED','EA',
-          'B','D','E','P','T','H','S');
-
-        postfixsorted : array[1..19] of TOpPostfix = (
-          PF_EP,PF_SB,PF_BT,PF_SH,
-          PF_IA,PF_IB,PF_DA,PF_DB,PF_FD,PF_FA,PF_ED,PF_EA,
-          PF_B,PF_D,PF_E,PF_P,PF_T,PF_H,PF_S);
-
-      var
-        str2opentry: tstr2opentry;
-        len,
-        j,
-        sufidx : longint;
-        hs : string;
-        maxlen : longint;
-        icond : tasmcond;
-      Begin
-        { making s a value parameter would break other assembler readers }
-        hs:=s;
-        is_asmopcode:=false;
-
-        { clear op code }
-        actopcode:=A_None;
-
-        actcondition:=C_None;
-
-        { first, handle B else BLS is read wrong }
-        if ((hs[1]='B') and (length(hs)=3)) then
-          begin
-            for icond:=low(tasmcond) to high(tasmcond) do
-              begin
-                if copy(hs,2,3)=uppercond2str[icond] then
-                  begin
-                    actopcode:=A_B;
-                    actasmtoken:=AS_OPCODE;
-                    actcondition:=icond;
-                    is_asmopcode:=true;
-                    exit;
-                  end;
-              end;
-          end;
-        maxlen:=max(length(hs),5);
-        for j:=maxlen downto 1 do
-          begin
-            str2opentry:=tstr2opentry(iasmops.search(copy(hs,1,j)));
-            if assigned(str2opentry) then
-              begin
-                actopcode:=str2opentry.op;
-                actasmtoken:=AS_OPCODE;
-                { strip op code }
-                delete(hs,1,j);
-                break;
-             end;
-          end;
-        if not(assigned(str2opentry)) then
-          exit;
-        { search for condition, conditions are always 2 chars }
-        if length(hs)>1 then
-          begin
-            for icond:=low(tasmcond) to high(tasmcond) do
-              begin
-                if copy(hs,1,2)=uppercond2str[icond] then
-                  begin
-                    actcondition:=icond;
-                    { strip condition }
-                    delete(hs,1,2);
-                    break;
-                  end;
-              end;
-          end;
-        { check for postfix }
-        if length(hs)>0 then
-          begin
-            for j:=low(postfixsorted) to high(postfixsorted) do
-              begin
-                if copy(hs,1,length(postfix2strsorted[j]))=postfix2strsorted[j] then
-                  begin
-                    actoppostfix:=postfixsorted[j];
-                    { strip postfix }
-                    delete(hs,1,length(postfix2strsorted[j]));
-                    break;
-                  end;
-              end;
-          end;
-        { if we stripped all postfixes, it's a valid opcode }
-        is_asmopcode:=length(hs)=0;
-      end;
-
-
-    procedure tarmattreader.ConvertCalljmp(instr : tarminstruction);
-      var
-        newopr : toprrec;
-      begin
-        if instr.Operands[1].opr.typ=OPR_REFERENCE then
-          begin
-            newopr.typ:=OPR_SYMBOL;
-            newopr.symbol:=instr.Operands[1].opr.ref.symbol;
-            newopr.symofs:=instr.Operands[1].opr.ref.offset;
-            if (instr.Operands[1].opr.ref.base<>NR_NO) or
-              (instr.Operands[1].opr.ref.index<>NR_NO) then
-              Message(asmr_e_syn_operand);
-            instr.Operands[1].opr:=newopr;
-          end;
-      end;
-
-
-    procedure tarmattreader.handleopcode;
-      var
-        instr : tarminstruction;
-      begin
-        instr:=TarmInstruction.Create(TarmOperand);
-        BuildOpcode(instr);
-        if is_calljmp(instr.opcode) then
-          ConvertCalljmp(instr);
-        {
-        instr.AddReferenceSizes;
-        instr.SetInstructionOpsize;
-        instr.CheckOperandSizes;
-        }
-        instr.ConcatInstruction(curlist);
-        instr.Free;
-        actoppostfix:=PF_None;
-      end;
-
-
-{*****************************************************************************
-                                     Initialize
-*****************************************************************************}
-
-const
-  asmmode_arm_att_info : tasmmodeinfo =
-          (
-            id    : asmmode_arm_gas;
-            idtxt : 'GAS';
-            casmreader : tarmattreader;
-          );
-
-  asmmode_arm_standard_info : tasmmodeinfo =
-          (
-            id    : asmmode_standard;
-            idtxt : 'STANDARD';
-            casmreader : tarmattreader;
-          );
-
-initialization
-  RegisterAsmMode(asmmode_arm_att_info);
-  RegisterAsmMode(asmmode_arm_standard_info);
-end.

compiler/compiler/arm/rarmcon.inc

@@ -1,74 +0,0 @@
-{ don't edit, this file is generated from armreg.dat }
-NR_NO = tregister($00000000);
-NR_R0 = tregister($01000000);
-NR_R1 = tregister($01000001);
-NR_R2 = tregister($01000002);
-NR_R3 = tregister($01000003);
-NR_R4 = tregister($01000004);
-NR_R5 = tregister($01000005);
-NR_R6 = tregister($01000006);
-NR_R7 = tregister($01000007);
-NR_R8 = tregister($01000008);
-NR_R9 = tregister($01000009);
-NR_R10 = tregister($0100000a);
-NR_R11 = tregister($0100000b);
-NR_R12 = tregister($0100000c);
-NR_R13 = tregister($0100000d);
-NR_R14 = tregister($0100000e);
-NR_R15 = tregister($0100000f);
-NR_F0 = tregister($02000000);
-NR_F1 = tregister($02000001);
-NR_F2 = tregister($02000002);
-NR_F3 = tregister($02000003);
-NR_F4 = tregister($02000004);
-NR_F5 = tregister($02000005);
-NR_F6 = tregister($02000006);
-NR_F7 = tregister($02000007);
-NR_S0 = tregister($03000000);
-NR_S1 = tregister($03000000);
-NR_D0 = tregister($03000000);
-NR_S2 = tregister($03000000);
-NR_S3 = tregister($03000000);
-NR_D1 = tregister($03000000);
-NR_S4 = tregister($03000000);
-NR_S5 = tregister($03000000);
-NR_D2 = tregister($03000000);
-NR_S6 = tregister($03000000);
-NR_S7 = tregister($03000000);
-NR_D3 = tregister($03000000);
-NR_S8 = tregister($03000000);
-NR_S9 = tregister($03000000);
-NR_D4 = tregister($03000000);
-NR_S10 = tregister($03000000);
-NR_S11 = tregister($03000000);
-NR_D5 = tregister($03000000);
-NR_S12 = tregister($03000000);
-NR_S13 = tregister($03000000);
-NR_D6 = tregister($03000000);
-NR_S14 = tregister($03000000);
-NR_S15 = tregister($03000000);
-NR_D7 = tregister($03000000);
-NR_S16 = tregister($03000000);
-NR_S17 = tregister($03000000);
-NR_D8 = tregister($03000000);
-NR_S18 = tregister($03000000);
-NR_S19 = tregister($03000000);
-NR_D9 = tregister($03000000);
-NR_S20 = tregister($03000000);
-NR_S21 = tregister($03000000);
-NR_D10 = tregister($03000000);
-NR_S22 = tregister($03000000);
-NR_S23 = tregister($03000000);
-NR_D11 = tregister($03000000);
-NR_S24 = tregister($03000000);
-NR_S25 = tregister($03000000);
-NR_D12 = tregister($03000000);
-NR_S26 = tregister($03000000);
-NR_S27 = tregister($03000000);
-NR_D13 = tregister($03000000);
-NR_S28 = tregister($03000000);
-NR_S29 = tregister($03000000);
-NR_D14 = tregister($03000000);
-NR_S30 = tregister($03000000);
-NR_S31 = tregister($03000000);
-NR_D15 = tregister($03000000);

compiler/compiler/arm/rarmdwa.inc

@@ -1,74 +0,0 @@
-{ don't edit, this file is generated from armreg.dat }
--1,
-0,
-1,
-2,
-3,
-4,
-5,
-6,
-7,
-8,
-9,
-10,
-11,
-12,
-13,
-14,
-15,
-16,
-17,
-18,
-19,
-20,
-21,
-22,
-23,
-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

compiler/compiler/arm/rarmnor.inc

@@ -1,2 +0,0 @@
-{ don't edit, this file is generated from armreg.dat }
-73

compiler/compiler/arm/rarmnum.inc

@@ -1,74 +0,0 @@
-{ don't edit, this file is generated from armreg.dat }
-tregister($00000000),
-tregister($01000000),
-tregister($01000001),
-tregister($01000002),
-tregister($01000003),
-tregister($01000004),
-tregister($01000005),
-tregister($01000006),
-tregister($01000007),
-tregister($01000008),
-tregister($01000009),
-tregister($0100000a),
-tregister($0100000b),
-tregister($0100000c),
-tregister($0100000d),
-tregister($0100000e),
-tregister($0100000f),
-tregister($02000000),
-tregister($02000001),
-tregister($02000002),
-tregister($02000003),
-tregister($02000004),
-tregister($02000005),
-tregister($02000006),
-tregister($02000007),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000),
-tregister($03000000)

compiler/compiler/arm/rarmrni.inc

@@ -1,74 +0,0 @@
-{ don't edit, this file is generated from armreg.dat }
-0,
-1,
-2,
-3,
-4,
-5,
-6,
-7,
-8,
-9,
-10,
-11,
-12,
-13,
-14,
-15,
-16,
-17,
-18,
-19,
-20,
-21,
-22,
-23,
-24,
-25,
-26,
-27,
-28,
-29,
-30,
-31,
-32,
-33,
-34,
-35,
-36,
-37,
-38,
-39,
-40,
-41,
-42,
-43,
-44,
-45,
-46,
-47,
-48,
-49,
-50,
-51,
-52,
-53,
-54,
-55,
-56,
-57,
-58,
-59,
-60,
-61,
-62,
-63,
-64,
-65,
-66,
-67,
-68,
-69,
-70,
-71,
-72

compiler/compiler/arm/rarmsri.inc

@@ -1,74 +0,0 @@
-{ don't edit, this file is generated from armreg.dat }
-0,
-27,
-30,
-57,
-60,
-63,
-66,
-69,
-72,
-33,
-36,
-39,
-42,
-45,
-48,
-51,
-54,
-17,
-18,
-19,
-20,
-21,
-22,
-23,
-24,
-1,
-2,
-11,
-12,
-13,
-14,
-15,
-16,
-3,
-4,
-5,
-6,
-7,
-8,
-9,
-10,
-25,
-26,
-40,
-41,
-43,
-44,
-46,
-47,
-49,
-50,
-52,
-53,
-28,
-55,
-70,
-71,
-56,
-58,
-59,
-61,
-62,
-64,
-65,
-67,
-68,
-29,
-31,
-32,
-34,
-35,
-37,
-38

compiler/compiler/arm/rarmsta.inc

@@ -1,74 +0,0 @@
-{ don't edit, this file is generated from armreg.dat }
--1,
-0,
-1,
-2,
-3,
-4,
-5,
-6,
-7,
-8,
-9,
-10,
-11,
-12,
-13,
-14,
-15,
-32,
-32,
-32,
-32,
-32,
-32,
-32,
-32,
-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

compiler/compiler/arm/rarmstd.inc

@@ -1,74 +0,0 @@
-{ don't edit, this file is generated from armreg.dat }
-'INVALID',
-'r0',
-'r1',
-'r2',
-'r3',
-'r4',
-'r5',
-'r6',
-'r7',
-'r8',
-'r9',
-'r10',
-'r11',
-'r12',
-'r13',
-'r14',
-'r15',
-'f0',
-'f1',
-'f2',
-'f3',
-'f4',
-'f5',
-'f6',
-'f7',
-'s0',
-'s1',
-'d0',
-'s2',
-'s3',
-'d1',
-'s4',
-'s5',
-'d2',
-'s6',
-'s7',
-'d3',
-'s8',
-'s9',
-'d4',
-'s10',
-'s11',
-'d5',
-'s12',
-'s13',
-'d6',
-'s14',
-'s15',
-'d7',
-'s16',
-'s17',
-'d8',
-'s18',
-'s19',
-'d9',
-'s20',
-'s21',
-'d10',
-'s22',
-'s23',
-'d11',
-'s24',
-'s25',
-'d12',
-'s26',
-'s27',
-'d13',
-'s28',
-'s29',
-'d14',
-'s20',
-'s21',
-'d15'

compiler/compiler/arm/rarmsup.inc

@@ -1,74 +0,0 @@
-{ don't edit, this file is generated from armreg.dat }
-RS_NO = $00;
-RS_R0 = $00;
-RS_R1 = $01;
-RS_R2 = $02;
-RS_R3 = $03;
-RS_R4 = $04;
-RS_R5 = $05;
-RS_R6 = $06;
-RS_R7 = $07;
-RS_R8 = $08;
-RS_R9 = $09;
-RS_R10 = $0a;
-RS_R11 = $0b;
-RS_R12 = $0c;
-RS_R13 = $0d;
-RS_R14 = $0e;
-RS_R15 = $0f;
-RS_F0 = $00;
-RS_F1 = $01;
-RS_F2 = $02;
-RS_F3 = $03;
-RS_F4 = $04;
-RS_F5 = $05;
-RS_F6 = $06;
-RS_F7 = $07;
-RS_S0 = $00;
-RS_S1 = $00;
-RS_D0 = $00;
-RS_S2 = $00;
-RS_S3 = $00;
-RS_D1 = $00;
-RS_S4 = $00;
-RS_S5 = $00;
-RS_D2 = $00;
-RS_S6 = $00;
-RS_S7 = $00;
-RS_D3 = $00;
-RS_S8 = $00;
-RS_S9 = $00;
-RS_D4 = $00;
-RS_S10 = $00;
-RS_S11 = $00;
-RS_D5 = $00;
-RS_S12 = $00;
-RS_S13 = $00;
-RS_D6 = $00;
-RS_S14 = $00;
-RS_S15 = $00;
-RS_D7 = $00;
-RS_S16 = $00;
-RS_S17 = $00;
-RS_D8 = $00;
-RS_S18 = $00;
-RS_S19 = $00;
-RS_D9 = $00;
-RS_S20 = $00;
-RS_S21 = $00;
-RS_D10 = $00;
-RS_S22 = $00;
-RS_S23 = $00;
-RS_D11 = $00;
-RS_S24 = $00;
-RS_S25 = $00;
-RS_D12 = $00;
-RS_S26 = $00;
-RS_S27 = $00;
-RS_D13 = $00;
-RS_S28 = $00;
-RS_S29 = $00;
-RS_D14 = $00;
-RS_S30 = $00;
-RS_S31 = $00;
-RS_D15 = $00;

compiler/compiler/arm/rgcpu.pas

@@ -1,168 +0,0 @@
-{
-    Copyright (c) 1998-2003 by Florian Klaempfl
-
-    This unit implements the arm 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,aasmcpu,
-       cgbase,cgutils,
-       cpubase,
-       rgobj;
-
-     type
-       trgcpu = class(trgobj)
-         procedure do_spill_read(list:Taasmoutput;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-         procedure do_spill_written(list:Taasmoutput;pos:tai;const spilltemp:treference;tempreg:tregister);override;
-       end;
-
-       trgintcpu = class(trgcpu)
-         procedure add_cpu_interferences(p : tai);override;
-       end;
-
-  implementation
-
-    uses
-      verbose, cutils,
-      cgobj,
-      procinfo;
-
-
-    procedure trgcpu.do_spill_read(list:Taasmoutput;pos:tai;const spilltemp:treference;tempreg:tregister);
-      var
-        helpins: tai;
-        tmpref : treference;
-        helplist : taasmoutput;
-        l : tasmlabel;
-        hreg : tregister;
-      begin
-        if abs(spilltemp.offset)>4095 then
-          begin
-            helplist:=taasmoutput.create;
-            reference_reset(tmpref);
-            { create consts entry }
-            objectlibrary.getjumplabel(l);
-            cg.a_label(current_procinfo.aktlocaldata,l);
-            tmpref.symboldata:=current_procinfo.aktlocaldata.last;
-
-            current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(spilltemp.offset));
-
-            { load consts entry }
-            if getregtype(tempreg)=R_INTREGISTER then
-              hreg:=getregisterinline(helplist,R_SUBWHOLE)
-            else
-              hreg:=cg.getintregister(helplist,OS_ADDR);
-
-            tmpref.symbol:=l;
-            tmpref.base:=NR_R15;
-            helplist.concat(taicpu.op_reg_ref(A_LDR,hreg,tmpref));
-
-            reference_reset_base(tmpref,hreg,0);
-
-            if spilltemp.index<>NR_NO then
-              internalerror(200401263);
-
-            helpins:=spilling_create_load(tmpref,tempreg);
-            helplist.concat(helpins);
-            if pos=nil then
-              list.insertlistafter(list.first,helplist)
-            else
-              list.insertlistafter(pos.next,helplist);
-
-            helplist.free;
-          end
-        else
-          inherited do_spill_read(list,pos,spilltemp,tempreg);
-      end;
-
-
-    procedure trgcpu.do_spill_written(list:Taasmoutput;pos:tai;const spilltemp:treference;tempreg:tregister);
-      var
-        helpins: tai;
-        tmpref : treference;
-        helplist : taasmoutput;
-        l : tasmlabel;
-        hreg : tregister;
-      begin
-        if abs(spilltemp.offset)>4095 then
-          begin
-            helplist:=taasmoutput.create;
-            reference_reset(tmpref);
-            { create consts entry }
-            objectlibrary.getjumplabel(l);
-            cg.a_label(current_procinfo.aktlocaldata,l);
-            tmpref.symboldata:=current_procinfo.aktlocaldata.last;
-
-            current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(spilltemp.offset));
-
-            { load consts entry }
-            if getregtype(tempreg)=R_INTREGISTER then
-              hreg:=getregisterinline(helplist,R_SUBWHOLE)
-            else
-              hreg:=cg.getintregister(helplist,OS_ADDR);
-            tmpref.symbol:=l;
-            tmpref.base:=NR_R15;
-            helplist.concat(taicpu.op_reg_ref(A_LDR,hreg,tmpref));
-
-            if spilltemp.index<>NR_NO then
-              internalerror(200401263);
-
-            reference_reset_base(tmpref,hreg,0);
-
-            helplist.concat(spilling_create_store(tempreg,tmpref));
-
-            if getregtype(tempreg)=R_INTREGISTER then
-              ungetregisterinline(helplist,hreg);
-
-            list.insertlistafter(pos,helplist)
-          end
-        else
-          inherited do_spill_written(list,pos,spilltemp,tempreg);
-      end;
-
-
-    procedure trgintcpu.add_cpu_interferences(p : tai);
-      begin
-        if p.typ=ait_instruction then
-          begin
-            case taicpu(p).opcode of
-              A_MUL:
-                add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg));
-              A_UMULL,
-              A_UMLAL,
-              A_SMULL,
-              A_SMLAL:
-                begin
-                  add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[1]^.reg));
-                  add_edge(getsupreg(taicpu(p).oper[1]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
-                  add_edge(getsupreg(taicpu(p).oper[0]^.reg),getsupreg(taicpu(p).oper[2]^.reg));
-                end;
-            end;
-          end;
-      end;
-
-
-end.

compiler/compiler/assemble.pas

@@ -1,1482 +0,0 @@
-{
-    Copyright (c) 1998-2004 by Peter Vreman
-
-    This unit handles the assemblerfile write and assembler calls of FPC
-
-    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.
-
- ****************************************************************************
-}
-{# @abstract(This unit handles the assembler file write and assembler calls of FPC)
-   Handles the calls to the actual external assemblers, as well as the generation
-   of object files for smart linking. Also contains the base class for writing
-   the assembler statements to file.
-}
-unit assemble;
-
-{$i fpcdefs.inc}
-
-interface
-
-
-    uses
-{$IFDEF USE_SYSUTILS}
-      sysutils,
-{$ELSE USE_SYSUTILS}
-      strings,
-      dos,
-{$ENDIF USE_SYSUTILS}
-      systems,globtype,globals,aasmbase,aasmtai,ogbase;
-
-    const
-       { maximum of aasmoutput lists there will be }
-       maxoutputlists = 20;
-       { buffer size for writing the .s file }
-       AsmOutSize=32768;
-
-    type
-      TAssembler=class(TAbstractAssembler)
-      public
-      {filenames}
-        path     : pathstr;
-        name     : namestr;
-        asmfile,         { current .s and .o file }
-        objfile  : string;
-        ppufilename : string;
-        asmprefix : string;
-        SmartAsm : boolean;
-        SmartFilesCount,
-        SmartHeaderCount : longint;
-        Constructor Create(smart:boolean);virtual;
-        Destructor Destroy;override;
-        procedure NextSmartName(place:tcutplace);
-        procedure MakeObject;virtual;abstract;
-      end;
-
-      {# This is the base class which should be overriden for each each
-         assembler writer. It is used to actually assembler a file,
-         and write the output to the assembler file.
-      }
-      TExternalAssembler=class(TAssembler)
-      private
-        procedure CreateSmartLinkPath(const s:string);
-      protected
-      {outfile}
-        AsmSize,
-        AsmStartSize,
-        outcnt   : longint;
-        outbuf   : array[0..AsmOutSize-1] of char;
-        outfile  : file;
-        ioerror : boolean;
-      public
-        {# Returns the complete path and executable name of the assembler
-           program.
-
-           It first tries looking in the UTIL directory if specified,
-           otherwise it searches in the free pascal binary directory, in
-           the current working directory and then in the  directories
-           in the $PATH environment.}
-        Function  FindAssembler:string;
-
-        {# Actually does the call to the assembler file. Returns false
-           if the assembling of the file failed.}
-        Function  CallAssembler(const command:string; const para:TCmdStr):Boolean;
-
-        Function  DoAssemble:boolean;virtual;
-        Procedure RemoveAsm;
-        Procedure AsmFlush;
-        Procedure AsmClear;
-
-        {# Write a string to the assembler file }
-        Procedure AsmWrite(const s:string);
-
-        {# Write a string to the assembler file }
-        Procedure AsmWritePChar(p:pchar);
-
-        {# Write a string to the assembler file followed by a new line }
-        Procedure AsmWriteLn(const s:string);
-
-        {# Write a new line to the assembler file }
-        Procedure AsmLn;
-
-        procedure AsmCreate(Aplace:tcutplace);
-        procedure AsmClose;
-
-        {# This routine should be overriden for each assembler, it is used
-           to actually write the abstract assembler stream to file.}
-        procedure WriteTree(p:TAAsmoutput);virtual;
-
-        {# This routine should be overriden for each assembler, it is used
-           to actually write all the different abstract assembler streams
-           by calling for each stream type, the @var(WriteTree) method.}
-        procedure WriteAsmList;virtual;
-      public
-        Constructor Create(smart:boolean);override;
-        procedure MakeObject;override;
-      end;
-
-      TInternalAssembler=class(TAssembler)
-      public
-        constructor create(smart:boolean);override;
-        destructor  destroy;override;
-        procedure MakeObject;override;
-      protected
-        objectdata   : TAsmObjectData;
-        objectoutput : tobjectoutput;
-      private
-        { the aasmoutput lists that need to be processed }
-        lists        : byte;
-        list         : array[1..maxoutputlists] of TAAsmoutput;
-        { current processing }
-        currlistidx  : byte;
-        currlist     : TAAsmoutput;
-        currpass     : byte;
-        procedure convertstab(p:pchar);
-        function  MaybeNextList(var hp:Tai):boolean;
-        function  TreePass0(hp:Tai):Tai;
-        function  TreePass1(hp:Tai):Tai;
-        function  TreePass2(hp:Tai):Tai;
-        procedure writetree;
-        procedure writetreesmart;
-      end;
-
-    TAssemblerClass = class of TAssembler;
-
-    Procedure GenerateAsm(smart:boolean);
-    Procedure OnlyAsm;
-
-    procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
-    procedure InitAssembler;
-    procedure DoneAssembler;
-
-
-Implementation
-
-    uses
-{$ifdef hasunix}
-  {$ifdef havelinuxrtl10}
-      linux,
-  {$else}
-      unix,
-  {$endif}
-{$endif}
-      cutils,script,fmodule,verbose,
-{$ifdef memdebug}
-      cclasses,
-{$endif memdebug}
-{$ifdef m68k}
-      cpuinfo,
-{$endif m68k}
-      aasmcpu
-      ;
-
-    var
-      CAssembler : array[tasm] of TAssemblerClass;
-
-
-{*****************************************************************************
-                                   TAssembler
-*****************************************************************************}
-
-    Constructor TAssembler.Create(smart:boolean);
-      begin
-      { load start values }
-        asmfile:=current_module.get_asmfilename;
-        objfile:=current_module.objfilename^;
-        name:=Lower(current_module.modulename^);
-        path:=current_module.outputpath^;
-        asmprefix := current_module.asmprefix^;
-        if not assigned(current_module.outputpath) then
-          ppufilename := ''
-        else
-          ppufilename := current_module.ppufilename^;
-        SmartAsm:=smart;
-        SmartFilesCount:=0;
-        SmartHeaderCount:=0;
-        SmartLinkOFiles.Clear;
-      end;
-
-
-    Destructor TAssembler.Destroy;
-      begin
-      end;
-
-
-    procedure TAssembler.NextSmartName(place:tcutplace);
-      var
-        s : string;
-      begin
-        inc(SmartFilesCount);
-        if SmartFilesCount>999999 then
-         Message(asmw_f_too_many_asm_files);
-        case place of
-          cut_begin :
-            begin
-              inc(SmartHeaderCount);
-              s:=asmprefix+tostr(SmartHeaderCount)+'h';
-            end;
-          cut_normal :
-            s:=asmprefix+tostr(SmartHeaderCount)+'s';
-          cut_end :
-            s:=asmprefix+tostr(SmartHeaderCount)+'t';
-        end;
-        AsmFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
-        ObjFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
-        { insert in container so it can be cleared after the linking }
-        SmartLinkOFiles.Insert(Objfile);
-      end;
-
-
-{*****************************************************************************
-                                 TExternalAssembler
-*****************************************************************************}
-
-    Function DoPipe:boolean;
-      begin
-        DoPipe:=(cs_asm_pipe in aktglobalswitches) and
-                not(cs_asm_leave in aktglobalswitches)
-                and ((target_asm.id in [as_gas,as_darwin]));
-      end;
-
-
-    Constructor TExternalAssembler.Create(smart:boolean);
-      begin
-        inherited Create(smart);
-        if SmartAsm then
-         begin
-           path:=FixPath(path+FixFileName(name)+target_info.smartext,false);
-           CreateSmartLinkPath(path);
-         end;
-        Outcnt:=0;
-      end;
-
-
-    procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
-      var
-{$IFDEF USE_SYSUTILS}
-        dir : TSearchRec;
-{$ELSE USE_SYSUTILS}
-        dir : searchrec;
-{$ENDIF USE_SYSUTILS}
-        hs  : string;
-      begin
-        if PathExists(s) then
-         begin
-           { the path exists, now we clean only all the .o and .s files }
-           { .o files }
-{$IFDEF USE_SYSUTILS}
-           if findfirst(s+source_info.dirsep+'*'+target_info.objext,faAnyFile,dir) = 0
-           then repeat
-              RemoveFile(s+source_info.dirsep+dir.name);
-           until findnext(dir) <> 0;
-{$ELSE USE_SYSUTILS}
-           findfirst(s+source_info.dirsep+'*'+target_info.objext,anyfile,dir);
-           while (doserror=0) do
-            begin
-              RemoveFile(s+source_info.dirsep+dir.name);
-              findnext(dir);
-            end;
-{$ENDIF USE_SYSUTILS}
-           findclose(dir);
-           { .s files }
-{$IFDEF USE_SYSUTILS}
-           if findfirst(s+source_info.dirsep+'*'+target_info.asmext,faAnyFile,dir) = 0
-           then repeat
-             RemoveFile(s+source_info.dirsep+dir.name);
-           until findnext(dir) <> 0;
-{$ELSE USE_SYSUTILS}
-           findfirst(s+source_info.dirsep+'*'+target_info.asmext,anyfile,dir);
-           while (doserror=0) do
-            begin
-              RemoveFile(s+source_info.dirsep+dir.name);
-              findnext(dir);
-            end;
-{$ENDIF USE_SYSUTILS}
-           findclose(dir);
-         end
-        else
-         begin
-           hs:=s;
-           if hs[length(hs)] in ['/','\'] then
-            delete(hs,length(hs),1);
-           {$I-}
-            mkdir(hs);
-           {$I+}
-           if ioresult<>0 then;
-         end;
-      end;
-
-
-    const
-      lastas  : byte=255;
-    var
-      LastASBin : pathstr;
-    Function TExternalAssembler.FindAssembler:string;
-      var
-        asfound : boolean;
-        UtilExe  : string;
-      begin
-        asfound:=false;
-        if cs_link_on_target in aktglobalswitches then
-         begin
-           { If linking on target, don't add any path PM }
-           FindAssembler:=utilsprefix+AddExtension(target_asm.asmbin,target_info.exeext);
-           exit;
-         end
-        else
-         UtilExe:=utilsprefix+AddExtension(target_asm.asmbin,source_info.exeext);
-        if lastas<>ord(target_asm.id) then
-         begin
-           lastas:=ord(target_asm.id);
-           { is an assembler passed ? }
-           if utilsdirectory<>'' then
-             asfound:=FindFile(UtilExe,utilsdirectory,LastASBin);
-           if not AsFound then
-             asfound:=FindExe(UtilExe,LastASBin);
-           if (not asfound) and not(cs_asm_extern in aktglobalswitches) then
-            begin
-              Message1(exec_e_assembler_not_found,LastASBin);
-              aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
-            end;
-           if asfound then
-            Message1(exec_t_using_assembler,LastASBin);
-         end;
-        FindAssembler:=LastASBin;
-      end;
-
-
-    Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean;
-{$IFDEF USE_SYSUTILS}
-      var
-        DosExitCode:Integer;
-{$ENDIF USE_SYSUTILS}
-      begin
-        callassembler:=true;
-        if not(cs_asm_extern in aktglobalswitches) then
-{$IFDEF USE_SYSUTILS}
-        try
-          DosExitCode := ExecuteProcess(command,para);
-          if DosExitCode <>0
-          then begin
-            Message1(exec_e_error_while_assembling,tostr(dosexitcode));
-            callassembler:=false;
-          end;
-        except on E:EOSError do
-          begin
-            Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
-            aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
-            callassembler:=false;
-          end
-        end
-{$ELSE USE_SYSUTILS}
-         begin
-           swapvectors;
-           exec(maybequoted(command),para);
-           swapvectors;
-           if (doserror<>0) then
-            begin
-              Message1(exec_e_cant_call_assembler,tostr(doserror));
-              aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
-              callassembler:=false;
-            end
-           else
-            if (dosexitcode<>0) then
-             begin
-              Message1(exec_e_error_while_assembling,tostr(dosexitcode));
-              callassembler:=false;
-             end;
-         end
-{$ENDIF USE_SYSUTILS}
-        else
-         AsmRes.AddAsmCommand(command,para,name);
-      end;
-
-
-    procedure TExternalAssembler.RemoveAsm;
-      var
-        g : file;
-      begin
-        if cs_asm_leave in aktglobalswitches then
-         exit;
-        if cs_asm_extern in aktglobalswitches then
-         AsmRes.AddDeleteCommand(AsmFile)
-        else
-         begin
-           assign(g,AsmFile);
-           {$I-}
-            erase(g);
-           {$I+}
-           if ioresult<>0 then;
-         end;
-      end;
-
-
-    Function TExternalAssembler.DoAssemble:boolean;
-      var
-        s : TCmdStr;
-      begin
-        DoAssemble:=true;
-        if DoPipe then
-         exit;
-        if not(cs_asm_extern in aktglobalswitches) then
-         begin
-           if SmartAsm then
-            begin
-              if (SmartFilesCount<=1) then
-               Message1(exec_i_assembling_smart,name);
-            end
-           else
-           Message1(exec_i_assembling,name);
-         end;
-        s:=target_asm.asmcmd;
-{$ifdef m68k}
-        if aktoptprocessor = MC68020 then
-          s:='-m68020 '+s
-        else
-          s:='-m68000 '+s;
-{$endif}
-        if (cs_link_on_target in aktglobalswitches) then
-         begin
-           Replace(s,'$ASM',maybequoted(ScriptFixFileName(AsmFile)));
-           Replace(s,'$OBJ',maybequoted(ScriptFixFileName(ObjFile)));
-         end
-        else
-         begin
-           Replace(s,'$ASM',maybequoted(AsmFile));
-           Replace(s,'$OBJ',maybequoted(ObjFile));
-         end;
-        if CallAssembler(FindAssembler,s) then
-         RemoveAsm
-        else
-         begin
-            DoAssemble:=false;
-            GenerateError;
-         end;
-      end;
-
-
-    Procedure TExternalAssembler.AsmFlush;
-      begin
-        if outcnt>0 then
-         begin
-           { suppress i/o error }
-           {$i-}
-           BlockWrite(outfile,outbuf,outcnt);
-           {$i+}
-           ioerror:=ioerror or (ioresult<>0);
-           outcnt:=0;
-         end;
-      end;
-
-
-    Procedure TExternalAssembler.AsmClear;
-      begin
-        outcnt:=0;
-      end;
-
-
-    Procedure TExternalAssembler.AsmWrite(const s:string);
-      begin
-        if OutCnt+length(s)>=AsmOutSize then
-         AsmFlush;
-        Move(s[1],OutBuf[OutCnt],length(s));
-        inc(OutCnt,length(s));
-        inc(AsmSize,length(s));
-      end;
-
-
-    Procedure TExternalAssembler.AsmWriteLn(const s:string);
-      begin
-        AsmWrite(s);
-        AsmLn;
-      end;
-
-
-    Procedure TExternalAssembler.AsmWritePChar(p:pchar);
-      var
-        i,j : longint;
-      begin
-        i:=StrLen(p);
-        j:=i;
-        while j>0 do
-         begin
-           i:=min(j,AsmOutSize);
-           if OutCnt+i>=AsmOutSize then
-            AsmFlush;
-           Move(p[0],OutBuf[OutCnt],i);
-           inc(OutCnt,i);
-           inc(AsmSize,i);
-           dec(j,i);
-           p:=pchar(@p[i]);
-         end;
-      end;
-
-
-    Procedure TExternalAssembler.AsmLn;
-      begin
-        if OutCnt>=AsmOutSize-2 then
-         AsmFlush;
-        if (cs_link_on_target in aktglobalswitches) then
-          begin
-            OutBuf[OutCnt]:=target_info.newline[1];
-            inc(OutCnt);
-            inc(AsmSize);
-            if length(target_info.newline)>1 then
-             begin
-               OutBuf[OutCnt]:=target_info.newline[2];
-               inc(OutCnt);
-               inc(AsmSize);
-             end;
-          end
-        else
-          begin
-            OutBuf[OutCnt]:=source_info.newline[1];
-            inc(OutCnt);
-            inc(AsmSize);
-            if length(source_info.newline)>1 then
-             begin
-               OutBuf[OutCnt]:=source_info.newline[2];
-               inc(OutCnt);
-               inc(AsmSize);
-             end;
-          end;
-      end;
-
-
-    procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
-      begin
-        if SmartAsm then
-         NextSmartName(Aplace);
-{$ifdef hasunix}
-        if DoPipe then
-         begin
-           Message1(exec_i_assembling_pipe,asmfile);
-           POpen(outfile,'as -o '+objfile,'W');
-         end
-        else
-{$endif}
-         begin
-           Assign(outfile,asmfile);
-           {$I-}
-           Rewrite(outfile,1);
-           {$I+}
-           if ioresult<>0 then
-             begin
-               ioerror:=true;
-               Message1(exec_d_cant_create_asmfile,asmfile);
-             end;
-         end;
-        outcnt:=0;
-        AsmSize:=0;
-        AsmStartSize:=0;
-      end;
-
-
-    procedure TExternalAssembler.AsmClose;
-      var
-        f : file;
-        FileAge : longint;
-      begin
-        AsmFlush;
-{$ifdef hasunix}
-        if DoPipe then
-          begin
-            if PClose(outfile) <> 0 then
-              GenerateError;
-          end
-        else
-{$endif}
-         begin
-         {Touch Assembler time to ppu time is there is a ppufilename}
-           if ppufilename<>'' then
-            begin
-              Assign(f,ppufilename);
-              {$I-}
-              reset(f,1);
-              {$I+}
-              if ioresult=0 then
-               begin
-{$IFDEF USE_SYSUTILS}
-                 FileAge := FileGetDate(GetFileHandle(f));
-{$ELSE USE_SYSUTILS}
-                 GetFTime(f, FileAge);
-{$ENDIF USE_SYSUTILS}
-                 close(f);
-                 reset(outfile,1);
-{$IFDEF USE_SYSUTILS}
-                 FileSetDate(GetFileHandle(outFile),FileAge);
-{$ELSE USE_SYSUTILS}
-                 SetFTime(f, FileAge);
-{$ENDIF USE_SYSUTILS}
-               end;
-            end;
-           close(outfile);
-         end;
-      end;
-
-
-    procedure TExternalAssembler.WriteTree(p:TAAsmoutput);
-      begin
-      end;
-
-
-    procedure TExternalAssembler.WriteAsmList;
-      begin
-      end;
-
-
-    procedure TExternalAssembler.MakeObject;
-      begin
-        AsmCreate(cut_normal);
-        WriteAsmList;
-        AsmClose;
-        if not(ioerror) then
-          DoAssemble;
-      end;
-
-
-{*****************************************************************************
-                                  TInternalAssembler
-*****************************************************************************}
-
-    constructor TInternalAssembler.create(smart:boolean);
-      begin
-        inherited create(smart);
-        objectoutput:=nil;
-        objectdata:=nil;
-        SmartAsm:=smart;
-        currpass:=0;
-      end;
-
-
-   destructor TInternalAssembler.destroy;
-{$ifdef MEMDEBUG}
-      var
-        d : tmemdebug;
-{$endif}
-      begin
-{$ifdef MEMDEBUG}
-        d := tmemdebug.create(name+' - agbin');
-{$endif}
-        objectdata.free;
-        objectoutput.free;
-{$ifdef MEMDEBUG}
-        d.free;
-{$endif}
-      end;
-
-
-    procedure TInternalAssembler.convertstab(p:pchar);
-
-        function consumecomma(var p:pchar):boolean;
-        begin
-          while (p^=' ') do
-            inc(p);
-          result:=(p^=',');
-          inc(p);
-        end;
-
-        function consumenumber(var p:pchar;out value:longint):boolean;
-        var
-          hs : string;
-          len,
-          code : integer;
-        begin
-          value:=0;
-          while (p^=' ') do
-            inc(p);
-          len:=0;
-          while (p^ in ['0'..'9']) do
-            begin
-              inc(len);
-              hs[len]:=p^;
-              inc(p);
-            end;
-          if len>0 then
-            begin
-              hs[0]:=chr(len);
-              val(hs,value,code);
-            end
-          else
-            code:=-1;
-          result:=(code=0);
-        end;
-
-        function consumeoffset(var p:pchar;out relocsym:tasmsymbol;out value:longint):boolean;
-        var
-          hs        : string;
-          len,
-          code      : integer;
-          pstart    : pchar;
-          sym       : tasmsymbol;
-          exprvalue : longint;
-          gotmin,
-          dosub     : boolean;
-        begin
-          result:=false;
-          value:=0;
-          relocsym:=nil;
-          gotmin:=false;
-          repeat
-            dosub:=false;
-            exprvalue:=0;
-            if gotmin then
-              begin
-                dosub:=true;
-                gotmin:=false;
-              end;
-            while (p^=' ') do
-              inc(p);
-            case p^ of
-              #0 :
-                break;
-              ' ' :
-                inc(p);
-              '0'..'9' :
-                begin
-                  len:=0;
-                  while (p^ in ['0'..'9']) do
-                    begin
-                      inc(len);
-                      hs[len]:=p^;
-                      inc(p);
-                    end;
-                  hs[0]:=chr(len);
-                  val(hs,exprvalue,code);
-                end;
-              '.','_',
-              'A'..'Z',
-              'a'..'z' :
-                begin
-                  pstart:=p;
-                  while not(p^ in [#0,' ','-','+']) do
-                    inc(p);
-                  len:=p-pstart;
-                  if len>255 then
-                    internalerror(200509187);
-                  move(pstart^,hs[1],len);
-                  hs[0]:=chr(len);
-                  sym:=objectlibrary.newasmsymbol(hs,AB_EXTERNAL,AT_NONE);
-                  if not assigned(sym) then
-                    internalerror(200509188);
-                  objectlibrary.UsedAsmSymbolListInsert(sym);
-                  { Second symbol? }
-                  if assigned(relocsym) then
-                    begin
-                      if (relocsym.section<>sym.section) then
-                        internalerror(2005091810);
-                      relocsym:=nil;
-                    end
-                  else
-                    begin
-                      relocsym:=sym;
-                    end;
-                  exprvalue:=sym.address;
-                end;
-              '+' :
-                begin
-                  { nothing, by default addition is done }
-                  inc(p);
-                end;
-              '-' :
-                begin
-                  gotmin:=true;
-                  inc(p);
-                end;
-              else
-                internalerror(200509189);
-            end;
-            if dosub then
-              dec(value,exprvalue)
-            else
-              inc(value,exprvalue);
-          until false;
-          result:=true;
-        end;
-
-      const
-        N_Function = $24; { function or const }
-      var
-        ofs,
-        nline,
-        nidx,
-        nother,
-        i         : longint;
-        relocsym  : tasmsymbol;
-        pstr,
-        pcurr,
-        pendquote : pchar;
-      begin
-        pcurr:=nil;
-        pstr:=nil;
-        pendquote:=nil;
-
-        { Parse string part }
-        if p[0]='"' then
-          begin
-            pstr:=@p[1];
-            { Ignore \" inside the string }
-            i:=1;
-            while not((p[i]='"') and (p[i-1]<>'\')) and
-                  (p[i]<>#0) do
-              inc(i);
-            pendquote:=@p[i];
-            pendquote^:=#0;
-            pcurr:=@p[i+1];
-            if not consumecomma(pcurr) then
-              internalerror(200509181);
-          end
-        else
-          pcurr:=p;
-
-        { When in pass 1 then only alloc and leave }
-        if currpass=1 then
-          objectdata.allocstab(pstr)
-        else
-          begin
-            { Stabs format: nidx,nother,nline[,offset] }
-            if not consumenumber(pcurr,nidx) then
-              internalerror(200509182);
-            if not consumecomma(pcurr) then
-              internalerror(200509183);
-            if not consumenumber(pcurr,nother) then
-              internalerror(200509184);
-            if not consumecomma(pcurr) then
-              internalerror(200509185);
-            if not consumenumber(pcurr,nline) then
-              internalerror(200509186);
-            if consumecomma(pcurr) then
-              consumeoffset(pcurr,relocsym,ofs)
-            else
-              begin
-                ofs:=0;
-                relocsym:=nil;
-              end;
-            if (nidx=N_Function) and
-               target_info.use_function_relative_addresses then
-              ofs:=0;
-            objectdata.writestab(ofs,relocsym,nidx,nother,nline,pstr);
-          end;
-        if assigned(pendquote) then
-          pendquote^:='"';
-      end;
-
-
-    function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
-      begin
-        { maybe end of list }
-        while not assigned(hp) do
-         begin
-           if currlistidx<lists then
-            begin
-              inc(currlistidx);
-              currlist:=list[currlistidx];
-              hp:=Tai(currList.first);
-            end
-           else
-            begin
-              MaybeNextList:=false;
-              exit;
-            end;
-         end;
-        MaybeNextList:=true;
-      end;
-
-
-    function TInternalAssembler.TreePass0(hp:Tai):Tai;
-      var
-        l : longint;
-      begin
-        while assigned(hp) do
-         begin
-           case hp.typ of
-             ait_align :
-               begin
-                 { always use the maximum fillsize in this pass to avoid possible
-                   short jumps to become out of range }
-                 Tai_align(hp).fillsize:=Tai_align(hp).aligntype;
-                 objectdata.alloc(Tai_align(hp).fillsize);
-               end;
-             ait_datablock :
-               begin
-                 l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
-                 if SmartAsm or (not Tai_datablock(hp).is_global) then
-                   begin
-                     objectdata.allocalign(l);
-                     objectdata.alloc(Tai_datablock(hp).size);
-                   end;
-               end;
-             ait_real_80bit :
-               objectdata.alloc(10);
-             ait_real_64bit :
-               objectdata.alloc(8);
-             ait_real_32bit :
-               objectdata.alloc(4);
-             ait_comp_64bit :
-               objectdata.alloc(8);
-             ait_const_64bit,
-             ait_const_32bit,
-             ait_const_16bit,
-             ait_const_8bit,
-             ait_const_rva_symbol,
-             ait_const_indirect_symbol :
-               objectdata.alloc(tai_const(hp).size);
-             ait_section:
-               begin
-                 objectdata.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secalign,[]);
-                 Tai_section(hp).sec:=objectdata.CurrSec;
-               end;
-             ait_symbol :
-               objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0);
-             ait_label :
-               objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
-             ait_string :
-               objectdata.alloc(Tai_string(hp).len);
-             ait_instruction :
-               begin
-{$ifdef i386}
-{$ifndef NOAG386BIN}
-                 { reset instructions which could change in pass 2 }
-                 Taicpu(hp).resetpass2;
-                 objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
-{$endif NOAG386BIN}
-{$endif i386}
-{$ifdef arm}
-                 { reset instructions which could change in pass 2 }
-                 Taicpu(hp).resetpass2;
-                 objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
-{$endif arm}
-               end;
-             ait_cutobject :
-               if SmartAsm then
-                break;
-           end;
-           hp:=Tai(hp.next);
-         end;
-        TreePass0:=hp;
-      end;
-
-
-    function TInternalAssembler.TreePass1(hp:Tai):Tai;
-      var
-        InlineLevel,
-        l,
-        i : longint;
-      begin
-        inlinelevel:=0;
-        while assigned(hp) do
-         begin
-           case hp.typ of
-             ait_align :
-               begin
-                 { here we must determine the fillsize which is used in pass2 }
-                 Tai_align(hp).fillsize:=align(objectdata.currsec.datasize,Tai_align(hp).aligntype)-
-                   objectdata.currsec.datasize;
-                 objectdata.alloc(Tai_align(hp).fillsize);
-               end;
-             ait_datablock :
-               begin
-                 if not (objectdata.currsec.sectype in [sec_bss,sec_threadvar]) then
-                   Message(asmw_e_alloc_data_only_in_bss);
-                 l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
-{                 if Tai_datablock(hp).is_global and
-                    not SmartAsm then
-                  begin}
-{                    objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);}
-                    { force to be common/external, must be after setaddress as that would
-                      set it to AB_GLOBAL }
-{                    Tai_datablock(hp).sym.currbind:=AB_COMMON;
-                  end
-                 else
-                  begin}
-                    objectdata.allocalign(l);
-                    objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);
-                    objectdata.alloc(Tai_datablock(hp).size);
-{                  end;}
-                 objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
-               end;
-             ait_real_80bit :
-               objectdata.alloc(10);
-             ait_real_64bit :
-               objectdata.alloc(8);
-             ait_real_32bit :
-               objectdata.alloc(4);
-             ait_comp_64bit :
-               objectdata.alloc(8);
-             ait_const_64bit,
-             ait_const_32bit,
-             ait_const_16bit,
-             ait_const_8bit,
-             ait_const_rva_symbol,
-             ait_const_indirect_symbol :
-               begin
-                 objectdata.alloc(tai_const(hp).size);
-                 if assigned(Tai_const(hp).sym) then
-                   objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).sym);
-                 if assigned(Tai_const(hp).endsym) then
-                   objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).endsym);
-               end;
-             ait_section:
-               begin
-                 { use cached value }
-                 objectdata.setsection(Tai_section(hp).sec);
-               end;
-             ait_stab :
-               begin
-                 if assigned(Tai_stab(hp).str) then
-                   convertstab(Tai_stab(hp).str);
-               end;
-             ait_function_name,
-             ait_force_line : ;
-             ait_symbol :
-               begin
-                 objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0);
-                 objectlibrary.UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
-               end;
-             ait_symbol_end :
-               begin
-                 if target_info.system in [system_i386_linux,system_i386_beos] then
-                  begin
-                    Tai_symbol_end(hp).sym.size:=objectdata.currsec.datasize-Tai_symbol_end(hp).sym.address;
-                    objectlibrary.UsedAsmSymbolListInsert(Tai_symbol_end(hp).sym);
-                  end;
-                end;
-             ait_label :
-               begin
-                 objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
-                 objectlibrary.UsedAsmSymbolListInsert(Tai_label(hp).l);
-               end;
-             ait_string :
-               objectdata.alloc(Tai_string(hp).len);
-             ait_instruction :
-               begin
-                 objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
-                 { fixup the references }
-                 for i:=1 to Taicpu(hp).ops do
-                  begin
-                    with Taicpu(hp).oper[i-1]^ do
-                     begin
-                       case typ of
-                         top_ref :
-                           begin
-                             if assigned(ref^.symbol) then
-                              objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
-                             if assigned(ref^.relsymbol) then
-                              objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
-                           end;
-                       end;
-                     end;
-                  end;
-               end;
-             ait_cutobject :
-               if SmartAsm then
-                break;
-             ait_marker :
-               if tai_marker(hp).kind=InlineStart then
-                 inc(InlineLevel)
-               else if tai_marker(hp).kind=InlineEnd then
-                 dec(InlineLevel);
-           end;
-           hp:=Tai(hp.next);
-         end;
-        TreePass1:=hp;
-      end;
-
-
-    function TInternalAssembler.TreePass2(hp:Tai):Tai;
-      var
-        fillbuffer : tfillbuffer;
-        InlineLevel,
-        l  : longint;
-        v  : int64;
-{$ifdef x86}
-        co : comp;
-{$endif x86}
-      begin
-        inlinelevel:=0;
-        { main loop }
-        while assigned(hp) do
-         begin
-           case hp.typ of
-             ait_align :
-               begin
-                 if objectdata.currsec.sectype in [sec_bss,sec_threadvar] then
-                   objectdata.alloc(Tai_align(hp).fillsize)
-                 else
-                   objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize);
-               end;
-             ait_section :
-               begin
-                 { use cached value }
-                 objectdata.setsection(Tai_section(hp).sec);
-               end;
-             ait_symbol :
-               begin
-                 objectdata.writesymbol(Tai_symbol(hp).sym);
-                 objectoutput.exportsymbol(Tai_symbol(hp).sym);
-               end;
-             ait_datablock :
-               begin
-                 l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
-                 objectdata.writesymbol(Tai_datablock(hp).sym);
-                 objectoutput.exportsymbol(Tai_datablock(hp).sym);
-{                 if SmartAsm or (not Tai_datablock(hp).is_global) then
-                   begin}
-                     objectdata.allocalign(l);
-                     objectdata.alloc(Tai_datablock(hp).size);
-{                   end;}
-               end;
-             ait_real_80bit :
-               objectdata.writebytes(Tai_real_80bit(hp).value,10);
-             ait_real_64bit :
-               objectdata.writebytes(Tai_real_64bit(hp).value,8);
-             ait_real_32bit :
-               objectdata.writebytes(Tai_real_32bit(hp).value,4);
-             ait_comp_64bit :
-               begin
-{$ifdef x86}
-                 co:=comp(Tai_comp_64bit(hp).value);
-                 objectdata.writebytes(co,8);
-{$endif x86}
-               end;
-             ait_string :
-               objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
-             ait_const_64bit,
-             ait_const_32bit,
-             ait_const_16bit,
-             ait_const_8bit :
-               begin
-                 if assigned(tai_const(hp).sym) then
-                   begin
-                     if assigned(tai_const(hp).endsym) then
-                       begin
-                         if tai_const(hp).endsym.section<>tai_const(hp).sym.section then
-                           internalerror(200404124);
-                         v:=tai_const(hp).endsym.address-tai_const(hp).sym.address+Tai_const(hp).value;
-                         objectdata.writebytes(v,tai_const(hp).size);
-                       end
-                     else
-                       objectdata.writereloc(Tai_const(hp).value,Tai_const(hp).size,
-                                             Tai_const(hp).sym,RELOC_ABSOLUTE);
-                   end
-                 else
-                   objectdata.writebytes(Tai_const(hp).value,tai_const(hp).size);
-               end;
-             ait_const_rva_symbol :
-               objectdata.writereloc(Tai_const(hp).value,sizeof(aint),Tai_const(hp).sym,RELOC_RVA);
-             ait_label :
-               begin
-                 objectdata.writesymbol(Tai_label(hp).l);
-                 { exporting shouldn't be necessary as labels are local,
-                   but it's better to be on the safe side (PFV) }
-                 objectoutput.exportsymbol(Tai_label(hp).l);
-               end;
-             ait_instruction :
-               Taicpu(hp).Pass2(objectdata);
-             ait_stab :
-               convertstab(Tai_stab(hp).str);
-             ait_function_name,
-             ait_force_line : ;
-             ait_cutobject :
-               if SmartAsm then
-                break;
-             ait_marker :
-               if tai_marker(hp).kind=InlineStart then
-                 inc(InlineLevel)
-               else if tai_marker(hp).kind=InlineEnd then
-                 dec(InlineLevel);
-           end;
-           hp:=Tai(hp.next);
-         end;
-        TreePass2:=hp;
-      end;
-
-
-    procedure TInternalAssembler.writetree;
-      var
-        hp : Tai;
-      label
-        doexit;
-      begin
-        objectdata:=objectoutput.newobjectdata(Objfile);
-        { reset the asmsymbol list }
-        objectlibrary.CreateUsedAsmsymbolList;
-
-      { Pass 0 }
-        currpass:=0;
-        objectdata.createsection(sec_code,'',0,[]);
-        objectdata.beforealloc;
-        { start with list 1 }
-        currlistidx:=1;
-        currlist:=list[currlistidx];
-        hp:=Tai(currList.first);
-        while assigned(hp) do
-         begin
-           hp:=TreePass0(hp);
-           MaybeNextList(hp);
-         end;
-        objectdata.afteralloc;
-        { leave if errors have occured }
-        if errorcount>0 then
-         goto doexit;
-
-      { Pass 1 }
-        currpass:=1;
-        objectdata.resetsections;
-        objectdata.beforealloc;
-        objectdata.createsection(sec_code,'',0,[]);
-        { start with list 1 }
-        currlistidx:=1;
-        currlist:=list[currlistidx];
-        hp:=Tai(currList.first);
-        while assigned(hp) do
-         begin
-           hp:=TreePass1(hp);
-           MaybeNextList(hp);
-         end;
-        objectdata.createsection(sec_code,'',0,[]);
-        objectdata.afteralloc;
-        { check for undefined labels and reset }
-        objectlibrary.UsedAsmSymbolListCheckUndefined;
-
-        { leave if errors have occured }
-        if errorcount>0 then
-         goto doexit;
-
-      { Pass 2 }
-        currpass:=2;
-        objectdata.resetsections;
-        objectdata.beforewrite;
-        objectdata.createsection(sec_code,'',0,[]);
-        { start with list 1 }
-        currlistidx:=1;
-        currlist:=list[currlistidx];
-        hp:=Tai(currList.first);
-        while assigned(hp) do
-         begin
-           hp:=TreePass2(hp);
-           MaybeNextList(hp);
-         end;
-        objectdata.createsection(sec_code,'',0,[]);
-        objectdata.afterwrite;
-
-        { don't write the .o file if errors have occured }
-        if errorcount=0 then
-         begin
-           { write objectfile }
-           objectoutput.startobjectfile(ObjFile);
-           objectoutput.writeobjectfile(objectdata);
-           objectdata.free;
-           objectdata:=nil;
-         end;
-
-      doexit:
-        { reset the used symbols back, must be after the .o has been
-          written }
-        objectlibrary.UsedAsmsymbolListReset;
-        objectlibrary.DestroyUsedAsmsymbolList;
-      end;
-
-
-    procedure TInternalAssembler.writetreesmart;
-      var
-        hp : Tai;
-        startsectype : TAsmSectionType;
-        place: tcutplace;
-      begin
-        NextSmartName(cut_normal);
-        objectdata:=objectoutput.newobjectdata(Objfile);
-        startsectype:=sec_code;
-
-        { start with list 1 }
-        currlistidx:=1;
-        currlist:=list[currlistidx];
-        hp:=Tai(currList.first);
-        while assigned(hp) do
-         begin
-         { reset the asmsymbol list }
-           objectlibrary.CreateUsedAsmSymbolList;
-
-         { Pass 0 }
-           currpass:=0;
-           objectdata.resetsections;
-           objectdata.beforealloc;
-           objectdata.createsection(startsectype,'',0,[]);
-           TreePass0(hp);
-           objectdata.afteralloc;
-           { leave if errors have occured }
-           if errorcount>0 then
-            exit;
-
-         { Pass 1 }
-           currpass:=1;
-           objectdata.resetsections;
-           objectdata.beforealloc;
-           objectdata.createsection(startsectype,'',0,[]);
-           TreePass1(hp);
-           objectdata.afteralloc;
-           { check for undefined labels }
-           objectlibrary.UsedAsmSymbolListCheckUndefined;
-
-           { leave if errors have occured }
-           if errorcount>0 then
-            exit;
-
-         { Pass 2 }
-           currpass:=2;
-           objectoutput.startobjectfile(Objfile);
-           objectdata.resetsections;
-           objectdata.beforewrite;
-           objectdata.createsection(startsectype,'',0,[]);
-           hp:=TreePass2(hp);
-           { save section type for next loop, must be done before EndFileLineInfo
-             because that changes the section to sec_code }
-           startsectype:=objectdata.currsec.sectype;
-           objectdata.afterwrite;
-           { leave if errors have occured }
-           if errorcount>0 then
-            exit;
-
-           { write the current objectfile }
-           objectoutput.writeobjectfile(objectdata);
-           objectdata.free;
-           objectdata:=nil;
-
-           { reset the used symbols back, must be after the .o has been
-             written }
-           objectlibrary.UsedAsmsymbolListReset;
-           objectlibrary.DestroyUsedAsmsymbolList;
-
-           { end of lists? }
-           if not MaybeNextList(hp) then
-            break;
-
-           { we will start a new objectfile so reset everything }
-           { The place can still change in the next while loop, so don't init }
-           { the writer yet (JM)                                              }
-           if (hp.typ=ait_cutobject) then
-            place := Tai_cutobject(hp).place
-           else
-            place := cut_normal;
-
-           { avoid empty files }
-           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
-              else if (Tai(hp).typ=ait_cutobject) then
-               place:=Tai_cutobject(hp).place;
-              hp:=Tai(hp.next);
-            end;
-           { there is a problem if startsectype is sec_none !! PM }
-           if startsectype=sec_none then
-             startsectype:=sec_code;
-
-           if not MaybeNextList(hp) then
-             break;
-
-           { start next objectfile }
-           NextSmartName(place);
-           objectdata:=objectoutput.newobjectdata(Objfile);
-         end;
-      end;
-
-
-    procedure TInternalAssembler.MakeObject;
-
-    var to_do:set of Tasmlist;
-        i:Tasmlist;
-
-        procedure addlist(p:TAAsmoutput);
-        begin
-          inc(lists);
-          list[lists]:=p;
-        end;
-
-      begin
-        to_do:=[low(Tasmlist)..high(Tasmlist)];
-        if usedeffileforexports then
-          exclude(to_do,al_exports);
-        {$warning TODO internal writer support for dwarf}
-        exclude(to_do,al_dwarf);
-{$ifndef segment_threadvars}
-        exclude(to_do,al_threadvars);
-{$endif}
-        for i:=low(Tasmlist) to high(Tasmlist) do
-          if (i in to_do) and (asmlist[i]<>nil) then
-            addlist(asmlist[i]);
-
-        if SmartAsm then
-          writetreesmart
-        else
-          writetree;
-      end;
-
-
-{*****************************************************************************
-                     Generate Assembler Files Main Procedure
-*****************************************************************************}
-
-    Procedure GenerateAsm(smart:boolean);
-      var
-        a : TAssembler;
-      begin
-        if not assigned(CAssembler[target_asm.id]) then
-          Message(asmw_f_assembler_output_not_supported);
-        a:=CAssembler[target_asm.id].Create(smart);
-        a.MakeObject;
-        a.Free;
-      end;
-
-
-    Procedure OnlyAsm;
-      var
-        a : TExternalAssembler;
-      begin
-        a:=TExternalAssembler.Create(false);
-        a.DoAssemble;
-        a.Free;
-      end;
-
-
-{*****************************************************************************
-                                 Init/Done
-*****************************************************************************}
-
-    procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
-      var
-        t : tasm;
-      begin
-        t:=r.id;
-        if assigned(asminfos[t]) then
-          writeln('Warning: Assembler is already registered!')
-        else
-          Getmem(asminfos[t],sizeof(tasminfo));
-        asminfos[t]^:=r;
-        CAssembler[t]:=c;
-      end;
-
-
-    procedure InitAssembler;
-      begin
-      end;
-
-
-    procedure DoneAssembler;
-      begin
-      end;
-
-end.

compiler/compiler/browcol.pas

@@ -1,2143 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Berczi Gabor
-    Modifications Copyright (c) 1999-2002 Florian Klaempfl and Pierre Muller
-
-    Support routines for getting browser info in collections
-
-    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.
-
- ****************************************************************************
-}
-{$ifdef TP}
-  {$N+,E+}
-{$endif}
-unit browcol;
-interface
-uses
-  objects,
-  cclasses,
-  symconst,symtable;
-
-{$ifndef FPC}
-  type
-    sw_integer = integer;
-{$endif FPC}
-
-const
-  SymbolTypLen : integer = 6;
-
-  RecordTypes : set of tsymtyp =
-    ([typesym,unitsym]);
-
-    sfRecord        = $00000001;
-    sfObject        = $00000002;
-    sfClass         = $00000004;
-    sfPointer       = $00000008;
-    sfHasMemInfo    = $80000000;
-
-type
-    TStoreCollection = object(TStringCollection)
-      function Add(const S: string): PString;
-    end;
-
-    PModuleNameCollection = ^TModuleNameCollection;
-    TModuleNameCollection = object(TStoreCollection)
-    end;
-
-    PTypeNameCollection = ^TTypeNameCollection;
-    TTypeNameCollection = object(TStoreCollection)
-    end;
-
-    PSymbolCollection       = ^TSymbolCollection;
-    PSortedSymbolCollection = ^TSortedSymbolCollection;
-    PReferenceCollection    = ^TReferenceCollection;
-
-    PReference = ^TReference;
-    TReference = object(TObject)
-      FileName  : PString;
-      Position  : TPoint;
-      constructor Init(AFileName: PString; ALine, AColumn: Sw_integer);
-      function    GetFileName: string;
-      destructor  Done; virtual;
-      constructor Load(var S: TStream);
-      procedure   Store(var S: TStream);
-    end;
-
-    PSymbolMemInfo = ^TSymbolMemInfo;
-    TSymbolMemInfo = record
-      Addr      : longint;
-      Size      : longint;
-      PushSize  : longint;
-    end;
-
-    PSymbol = ^TSymbol;
-    TSymbol = object(TObject)
-      Name       : PString;
-      Typ        : tsymtyp;
-      Params     : PString;
-      References : PReferenceCollection;
-      Items      : PSymbolCollection;
-      DType      : PString;
-      VType      : PString;
-      TypeID     : Ptrint;
-      RelatedTypeID : Ptrint;
-      DebuggerCount : longint;
-      Ancestor   : PSymbol;
-      Flags      : longint;
-      MemInfo    : PSymbolMemInfo;
-      constructor Init(const AName: string; ATyp: tsymtyp; AParams: string; AMemInfo: PSymbolMemInfo);
-      procedure   SetMemInfo(const AMemInfo: TSymbolMemInfo);
-      function    GetReferenceCount: Sw_integer;
-      function    GetReference(Index: Sw_integer): PReference;
-      function    GetItemCount: Sw_integer;
-      function    GetItem(Index: Sw_integer): PSymbol;
-      function    GetName: string;
-      function    GetText: string;
-      function    GetTypeName: string;
-      destructor  Done; virtual;
-      constructor Load(var S: TStream);
-      procedure   Store(var S: TStream);
-    end;
-
-    PExport = ^TExport;
-    TExport = object(TObject)
-      constructor Init(const AName: string; AIndex: longint; ASymbol: PSymbol);
-      function    GetDisplayText: string;
-      destructor  Done; virtual;
-    private
-      Name: PString;
-      Index: longint;
-      Symbol: PSymbol;
-    end;
-
-    PExportCollection = ^TExportCollection;
-    TExportCollection = object(TSortedCollection)
-      function At(Index: sw_Integer): PExport;
-      function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
-    end;
-
-    PImport = ^TImport;
-    TImport = object(TObject)
-      constructor Init(const ALibName, AFuncName,ARealName: string; AIndex: longint);
-      function    GetDisplayText: string;
-      destructor  Done; virtual;
-    private
-      LibName: PString;
-      FuncName: PString;
-      RealName: PString;
-      Index: longint;
-    end;
-
-    PImportCollection = ^TImportCollection;
-    TImportCollection = object(TSortedCollection)
-      function At(Index: sw_Integer): PImport;
-      function Compare(Key1, Key2: Pointer): sw_Integer; virtual;
-    end;
-
-    PObjectSymbolCollection = ^TObjectSymbolCollection;
-
-    PObjectSymbol = ^TObjectSymbol;
-    TObjectSymbol = object(TObject)
-      Parent     : PObjectSymbol;
-      Symbol     : PSymbol;
-      Expanded   : boolean;
-      constructor Init(AParent: PObjectSymbol; ASymbol: PSymbol);
-      constructor InitName(const AName: string);
-      function    GetName: string;
-      function    GetDescendantCount: sw_integer;
-      function    GetDescendant(Index: sw_integer): PObjectSymbol;
-      procedure   AddDescendant(P: PObjectSymbol);
-      destructor  Done; virtual;
-      constructor Load(var S: TStream);
-      procedure   Store(S: TStream);
-    private
-      Name: PString;
-      Descendants: PObjectSymbolCollection;
-    end;
-
-    TSymbolCollection = object(TSortedCollection)
-       constructor Init(ALimit, ADelta: Integer);
-       function  At(Index: Sw_Integer): PSymbol;
-       procedure Insert(Item: Pointer); virtual;
-       function  LookUp(const S: string; var Idx: sw_integer): string; virtual;
-    end;
-
-    TSortedSymbolCollection = object(TSymbolCollection)
-      function  Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
-      procedure Insert(Item: Pointer); virtual;
-      function  LookUp(const S: string; var Idx: sw_integer): string; virtual;
-    end;
-
-    PIDSortedSymbolCollection = ^TIDSortedSymbolCollection;
-    TIDSortedSymbolCollection = object(TSymbolCollection)
-      function  Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
-      procedure Insert(Item: Pointer); virtual;
-      function  SearchSymbolByID(AID: longint): PSymbol;
-    end;
-
-    TObjectSymbolCollection = object(TSortedCollection)
-      constructor Init(ALimit, ADelta: Integer);
-      function  Compare(Key1, Key2: Pointer): Sw_Integer; virtual;
-      function  LookUp(const S: string; var Idx: sw_integer): string; virtual;
-       function At(Index: Sw_Integer): PObjectSymbol;
-    end;
-
-    TReferenceCollection = object(TCollection)
-       function At(Index: Sw_Integer): PReference;
-    end;
-
-    PSourceFile = ^TSourceFile;
-    TSourceFile = object(TObject)
-      SourceFileName: PString;
-      ObjFileName: PString;
-      PPUFileName: PString;
-      constructor Init(ASourceFileName, AObjFileName, APPUFileName: string);
-      destructor  Done; virtual;
-      function    GetSourceFilename: string;
-      function    GetObjFileName: string;
-      function    GetPPUFileName: string;
-    end;
-
-    PSourceFileCollection = ^TSourceFileCollection;
-    TSourceFileCollection = object(TCollection)
-      function At(Index: sw_Integer): PSourceFile;
-    end;
-
-    PModuleSymbol = ^TModuleSymbol;
-    TModuleSymbol = object(TSymbol)
-      Exports_   : PExportCollection;
-      Imports    : PImportCollection;
-      LoadedFrom : PString;
-      UsedUnits  : PSymbolCollection;
-      DependentUnits: PSymbolCollection;
-      MainSource: PString;
-      SourceFiles: PStringCollection;
-      constructor Init(const AName, AMainSource: string);
-      procedure   SetLoadedFrom(const AModuleName: string);
-      procedure   AddUsedUnit(P: PSymbol);
-      procedure   AddDependentUnit(P: PSymbol);
-      procedure   AddSourceFile(const Path: string);
-      destructor  Done; virtual;
-    end;
-
-const
-  Modules     : PSymbolCollection = nil;
-  ModuleNames : PModuleNameCollection = nil;
-  TypeNames   : PTypeNameCollection = nil;
-  ObjectTree  : PObjectSymbol = nil;
-  SourceFiles : PSourceFileCollection = nil;
-
-procedure DisposeBrowserCol;
-procedure NewBrowserCol;
-procedure CreateBrowserCol;
-procedure InitBrowserCol;
-procedure DoneBrowserCol;
-
-function  LoadBrowserCol(S: PStream): boolean;
-function  StoreBrowserCol(S: PStream) : boolean;
-
-procedure BuildObjectInfo;
-
-procedure BuildSourceList;
-
-function SearchObjectForSymbol(O: PSymbol): PObjectSymbol;
-
-procedure RegisterSymbols;
-
-implementation
-
-uses
-{$IFDEF USE_SYSUTILS}
-  SysUtils,
-{$ELSE USE_SYSUTILS}
-  Dos,{$ifndef FPC}strings,{$endif}
-{$ENDIF USE_SYSUTILS}
-{$ifdef DEBUG}
-  verbose,
-{$endif DEBUG}
-  CUtils,
-  globtype,globals,comphook,
-  finput,fmodule,
-  cpuinfo,cgbase,aasmbase,aasmtai,paramgr,
-  symsym,symdef,symtype,symbase,defutil;
-
-const
-  RModuleNameCollection: TStreamRec = (
-     ObjType: 3001;
-     VmtLink: Ofs(TypeOf(TModuleNameCollection)^);
-     Load:    @TModuleNameCollection.Load;
-     Store:   @TModuleNameCollection.Store
-  );
-  RTypeNameCollection: TStreamRec = (
-     ObjType: 3002;
-     VmtLink: Ofs(TypeOf(TTypeNameCollection)^);
-     Load:    @TTypeNameCollection.Load;
-     Store:   @TTypeNameCollection.Store
-  );
-  RReference: TStreamRec = (
-     ObjType: 3003;
-     VmtLink: Ofs(TypeOf(TReference)^);
-     Load:    @TReference.Load;
-     Store:   @TReference.Store
-  );
-  RSymbol: TStreamRec = (
-     ObjType: 3004;
-     VmtLink: Ofs(TypeOf(TSymbol)^);
-     Load:    @TSymbol.Load;
-     Store:   @TSymbol.Store
-  );
-  RObjectSymbol: TStreamRec = (
-     ObjType: 3005;
-     VmtLink: Ofs(TypeOf(TObjectSymbol)^);
-     Load:    @TObjectSymbol.Load;
-     Store:   @TObjectSymbol.Store
-  );
-  RSymbolCollection: TStreamRec = (
-     ObjType: 3006;
-     VmtLink: Ofs(TypeOf(TSymbolCollection)^);
-     Load:    @TSymbolCollection.Load;
-     Store:   @TSymbolCollection.Store
-  );
-  RSortedSymbolCollection: TStreamRec = (
-     ObjType: 3007;
-     VmtLink: Ofs(TypeOf(TSortedSymbolCollection)^);
-     Load:    @TSortedSymbolCollection.Load;
-     Store:   @TSortedSymbolCollection.Store
-  );
-  RIDSortedSymbolCollection: TStreamRec = (
-     ObjType: 3008;
-     VmtLink: Ofs(TypeOf(TIDSortedSymbolCollection)^);
-     Load:    @TIDSortedSymbolCollection.Load;
-     Store:   @TIDSortedSymbolCollection.Store
-  );
-  RObjectSymbolCollection: TStreamRec = (
-     ObjType: 3009;
-     VmtLink: Ofs(TypeOf(TObjectSymbolCollection)^);
-     Load:    @TObjectSymbolCollection.Load;
-     Store:   @TObjectSymbolCollection.Store
-  );
-  RReferenceCollection: TStreamRec = (
-     ObjType: 3010;
-     VmtLink: Ofs(TypeOf(TReferenceCollection)^);
-     Load:    @TReferenceCollection.Load;
-     Store:   @TReferenceCollection.Store
-  );
-  RModuleSymbol: TStreamRec = (
-     ObjType: 3011;
-     VmtLink: Ofs(TypeOf(TModuleSymbol)^);
-     Load:    @TModuleSymbol.Load;
-     Store:   @TModuleSymbol.Store
-  );
-
-{****************************************************************************
-                                   Helpers
-****************************************************************************}
-
-function GetStr(P: PString): string;
-begin
-  if P=nil then
-    GetStr:=''
-  else
-    GetStr:=P^;
-end;
-
-function IntToStr(L: longint): string;
-var S: string;
-begin
-  Str(L,S);
-  IntToStr:=S;
-end;
-
-function UpcaseStr(S: string): string;
-var I: integer;
-begin
-  for I:=1 to length(S) do
-      S[I]:=Upcase(S[I]);
-  UpcaseStr:=S;
-end;
-
-function FloatToStr(E: extended): string;
-var S: string;
-begin
-  Str(E:0:24,S);
-  if Pos('.',S)>0 then
-    begin
-      while (length(S)>0) and (S[length(S)]='0') do
-        Delete(S,length(S),1);
-      if (length(S)>0) and (S[length(S)]='.') then
-        Delete(S,length(S),1);
-    end;
-  if S='' then S:='0';
-  FloatToStr:=S;
-end;
-
-{****************************************************************************
-                                TStoreCollection
-****************************************************************************}
-
-function TStoreCollection.Add(const S: string): PString;
-var P: PString;
-    Index: Sw_integer;
-begin
-  if S='' then P:=nil else
-  if Search(@S,Index) then P:=At(Index) else
-    begin
-      P:=NewStr(S);
-      Insert(P);
-    end;
-  Add:=P;
-end;
-
-
-{****************************************************************************
-                                TSymbolCollection
-****************************************************************************}
-
-constructor TSymbolCollection.Init(ALimit, ADelta: Integer);
-begin
-  inherited Init(ALimit,ADelta);
-{  Duplicates:=true;}
-end;
-
-function TSymbolCollection.At(Index: Sw_Integer): PSymbol;
-begin
-  At:=inherited At(Index);
-end;
-
-procedure TSymbolCollection.Insert(Item: Pointer);
-begin
-
-  TCollection.Insert(Item);
-end;
-
-function TSymbolCollection.LookUp(const S: string; var Idx: sw_integer): string;
-begin
-  Idx:=-1;
-  LookUp:='';
-end;
-
-{****************************************************************************
-                               TReferenceCollection
-****************************************************************************}
-
-function TReferenceCollection.At(Index: Sw_Integer): PReference;
-begin
-  At:=inherited At(Index);
-end;
-
-
-{****************************************************************************
-                            TSortedSymbolCollection
-****************************************************************************}
-
-function TSortedSymbolCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
-var K1: PSymbol absolute Key1;
-    K2: PSymbol absolute Key2;
-    R: Sw_integer;
-    S1,S2: string;
-begin
-  S1:=Upper(K1^.GetName);
-  S2:=Upper(K2^.GetName);
-  if S1<S2 then R:=-1 else
-  if S1>S2 then R:=1 else
-   if K1^.TypeID=K2^.TypeID then R:=0 else
-    begin
-      S1:=K1^.GetName;
-      S2:=K2^.GetName;
-      if S1<S2 then R:=-1 else
-      if S1>S2 then R:=1 else
-       if K1^.TypeID<K2^.TypeID then R:=-1 else
-       if K1^.TypeID>K2^.TypeID then R:= 1 else
-        R:=0;
-    end;
-  Compare:=R;
-end;
-
-procedure TSortedSymbolCollection.Insert(Item: Pointer);
-begin
-  TSortedCollection.Insert(Item);
-end;
-
-function TSortedSymbolCollection.LookUp(const S: string; var Idx: sw_integer): string;
-var OLI,ORI,Left,Right,Mid: integer;
-    LeftP,RightP,MidP: PSymbol;
-    LeftS,MidS,RightS: string;
-    FoundS: string;
-    UpS : string;
-begin
-  Idx:=-1; FoundS:='';
-  Left:=0; Right:=Count-1;
-  UpS:=Upper(S);
-  if Left<Right then
-  begin
-    while (Left<Right) do
-    begin
-      OLI:=Left; ORI:=Right;
-      Mid:=Left+(Right-Left) div 2;
-      MidP:=At(Mid);
-{$ifdef DEBUG}
-      LeftP:=At(Left); RightP:=At(Right);
-      LeftS:=Upper(LeftP^.GetName);
-      RightS:=Upper(RightP^.GetName);
-{$endif DEBUG}
-      MidS:=Upper(MidP^.GetName);
-      if copy(MidS,1,length(UpS))=UpS then
-        begin
-          Idx:=Mid;
-          FoundS:=MidS;
-        end;
-{      else}
-        if UpS<MidS then
-          Right:=Mid
-        else
-          Left:=Mid;
-      if (OLI=Left) and (ORI=Right) then
-        begin
-          if idX<>-1 then
-            break;
-          if Mid=Left then
-            begin
-              RightP:=At(Right);
-              RightS:=Upper(RightP^.GetName);
-              if copy(RightS,1,length(UpS))=UpS then
-                begin
-                  Idx:=Right;
-                  FoundS:=RightS;
-                end;
-            end;
-          if Mid=Right then
-            begin
-              LeftP:=At(Left);
-              LeftS:=Upper(LeftP^.GetName);
-              if copy(LeftS,1,length(UpS))=UpS then
-                begin
-                  Idx:=Left;
-                  FoundS:=LeftS;
-                end;
-            end;
-          Break;
-        end;
-    end;
-  end;
-  LookUp:=FoundS;
-end;
-
-{****************************************************************************
-                           TIDSortedSymbolCollection
-****************************************************************************}
-
-function TIDSortedSymbolCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
-var K1: PSymbol absolute Key1;
-    K2: PSymbol absolute Key2;
-    R: Sw_integer;
-begin
-  if K1^.TypeID<K2^.TypeID then R:=-1 else
-  if K1^.TypeID>K2^.TypeID then R:= 1 else
-  R:=0;
-  Compare:=R;
-end;
-
-procedure TIDSortedSymbolCollection.Insert(Item: Pointer);
-begin
-  TSortedCollection.Insert(Item);
-end;
-
-function TIDSortedSymbolCollection.SearchSymbolByID(AID: longint): PSymbol;
-var S: TSymbol;
-    Index: sw_integer;
-    P: PSymbol;
-begin
-  S.TypeID:=AID;
-  if Search(@S,Index)=false then P:=nil else
-    P:=At(Index);
-  SearchSymbolByID:=P;
-end;
-
-{****************************************************************************
-                           TObjectSymbolCollection
-****************************************************************************}
-
-function TObjectSymbolCollection.At(Index: Sw_Integer): PObjectSymbol;
-begin
-  At:=inherited At(Index);
-end;
-
-constructor TObjectSymbolCollection.Init(ALimit, ADelta: Integer);
-begin
-  inherited Init(ALimit,ADelta);
-end;
-
-function TObjectSymbolCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
-var K1: PObjectSymbol absolute Key1;
-    K2: PObjectSymbol absolute Key2;
-    R: Sw_integer;
-    S1,S2: string;
-begin
-  S1:=Upper(K1^.GetName);
-  S2:=Upper(K2^.GetName);
-  if S1<S2 then R:=-1 else
-  if S1>S2 then R:=1 else
-  { make sure that we distinguish between different objects with the same name }
-  if Ptrint(K1^.Symbol)<Ptrint(K2^.Symbol) then R:=-1 else
-  if Ptrint(K1^.Symbol)>Ptrint(K2^.Symbol) then R:= 1 else
-  R:=0;
-  Compare:=R;
-end;
-
-function TObjectSymbolCollection.LookUp(const S: string; var Idx: sw_integer): string;
-var OLI,ORI,Left,Right,Mid: integer;
-    {LeftP,RightP,}MidP: PObjectSymbol;
-    {LeftS,RightS,}MidS: string;
-    FoundS: string;
-    UpS : string;
-begin
-  Idx:=-1; FoundS:='';
-  Left:=0; Right:=Count-1;
-  UpS:=Upper(S);
-  if Left<Right then
-  begin
-    while (Left<Right) do
-    begin
-      OLI:=Left; ORI:=Right;
-      Mid:=Left+(Right-Left) div 2;
-      {LeftP:=At(Left);
-       LeftS:=Upper(LeftP^.GetName);}
-      MidP:=At(Mid);
-      MidS:=Upper(MidP^.GetName);
-      {RightP:=At(Right);
-       RightS:=Upper(RightP^.GetName);}
-      if copy(MidS,1,length(UpS))=UpS then
-        begin
-          Idx:=Mid;
-          FoundS:=MidS;
-        end;
-{      else}
-        if UpS<MidS then
-          Right:=Mid
-        else
-          Left:=Mid;
-      if (OLI=Left) and (ORI=Right) then
-        Break;
-    end;
-  end;
-  LookUp:=FoundS;
-end;
-
-{****************************************************************************
-                                TReference
-****************************************************************************}
-
-constructor TReference.Init(AFileName: PString; ALine, AColumn: Sw_integer);
-begin
-  inherited Init;
-  FileName:=AFileName;
-  Position.X:=AColumn;
-  Position.Y:=ALine;
-end;
-
-function TReference.GetFileName: string;
-begin
-  GetFileName:=GetStr(FileName);
-end;
-
-destructor TReference.Done;
-begin
-  inherited Done;
-end;
-
-constructor TReference.Load(var S: TStream);
-begin
-  S.Read(Position, SizeOf(Position));
-
-  { --- items needing fixup --- }
-  S.Read(FileName, SizeOf(FileName)); { ->ModulesNames^.Item }
-end;
-
-procedure TReference.Store(var S: TStream);
-begin
-  S.Write(Position, SizeOf(Position));
-
-  { --- items needing fixup --- }
-  S.Write(FileName, SizeOf(FileName));
-end;
-
-{****************************************************************************
-                                   TSymbol
-****************************************************************************}
-
-constructor TSymbol.Init(const AName: string; ATyp: tsymtyp; AParams: string; AMemInfo: PSymbolMemInfo);
-begin
-  inherited Init;
-  Name:=NewStr(AName); Typ:=ATyp;
-  if AMemInfo<>nil then
-    SetMemInfo(AMemInfo^);
-  New(References, Init(20,50));
-  if ATyp in RecordTypes then
-    begin
-      Items:=New(PSortedSymbolCollection, Init(50,100));
-    end;
-end;
-
-procedure TSymbol.SetMemInfo(const AMemInfo: TSymbolMemInfo);
-begin
-  if MemInfo=nil then New(MemInfo);
-  Move(AMemInfo,MemInfo^,SizeOf(MemInfo^));
-  Flags:=Flags or sfHasMemInfo;
-end;
-
-function TSymbol.GetReferenceCount: Sw_integer;
-var Count: Sw_integer;
-begin
-  if References=nil then Count:=0 else
-    Count:=References^.Count;
-  GetReferenceCount:=Count;
-end;
-
-function TSymbol.GetReference(Index: Sw_integer): PReference;
-begin
-  GetReference:=References^.At(Index);
-end;
-
-function TSymbol.GetItemCount: Sw_integer;
-var Count: Sw_integer;
-begin
-  if Items=nil then Count:=0 else
-    Count:=Items^.Count;
-  GetItemCount:=Count;
-end;
-
-function TSymbol.GetItem(Index: Sw_integer): PSymbol;
-begin
-  GetItem:=Items^.At(Index);
-end;
-
-function TSymbol.GetName: string;
-begin
-  GetName:=GetStr(Name);
-end;
-
-function TSymbol.GetText: string;
-var S: string;
-begin
-  S:=GetTypeName;
-  if length(S)>SymbolTypLen then
-   S:=Copy(S,1,SymbolTypLen)
-  else
-   begin
-     while length(S)<SymbolTypLen do
-      S:=S+' ';
-   end;
-  S:=S+' '+GetName;
-  if (Flags and sfRecord)<>0 then
-    S:=S+' = record'
-  else
-  if (Flags and sfObject)<>0 then
-    begin
-      S:=S+' = ';
-      if (Flags and sfClass)<>0 then
-        S:=S+'class'
-      else
-        S:=S+'object';
-      if Ancestor<>nil then
-        S:=S+'('+Ancestor^.GetName+')';
-    end
-  else
-    begin
-      if Assigned(DType) then
-        S:=S+' = '+DType^;
-      if Assigned(Params) then
-        S:=S+'('+Params^+')';
-      if Assigned(VType) then
-        S:=S+': '+VType^;
-    end;
-  GetText:=S;
-end;
-
-function TSymbol.GetTypeName: string;
-var S: string;
-begin
-  case Typ of
-    abstractsym  : S:='abst';
-    fieldvarsym  : S:='member';
-    globalvarsym,
-    localvarsym,
-    paravarsym   : S:='var';
-    typesym      : S:='type';
-    procsym      : if VType=nil then
-                     S:='proc'
-                   else
-                     S:='func';
-    unitsym      : S:='unit';
-    constsym     : S:='const';
-    enumsym      : S:='enum';
-    typedconstsym: S:='const';
-    errorsym     : S:='error';
-    syssym       : S:='sys';
-    labelsym     : S:='label';
-    absolutevarsym : S:='abs';
-    propertysym  : S:='prop';
-    macrosym     : S:='macro';
-  else S:='';
-  end;
-  GetTypeName:=S;
-end;
-
-destructor TSymbol.Done;
-begin
-  inherited Done;
-  if assigned(MemInfo) then
-    Dispose(MemInfo);
-  if assigned(References) then
-    Dispose(References, Done);
-  if assigned(Items) then
-    Dispose(Items, Done);
-  if assigned(Name) then
-    DisposeStr(Name);
-{  if assigned(Params) then
-    DisposeStr(Params); in TypeNames
-  if assigned(VType) then
-    DisposeStr(VType);
-  if assigned(DType) then
-    DisposeStr(DType);
-  if assigned(Ancestor) then
-    DisposeStr(Ancestor);}
-end;
-
-constructor TSymbol.Load(var S: TStream);
-var MI: TSymbolMemInfo;
-    W: word;
-begin
-  TObject.Init;
-
-  S.Read(Typ,SizeOf(Typ));
-  S.Read(TypeID, SizeOf(TypeID));
-  S.Read(RelatedTypeID, SizeOf(RelatedTypeID));
-  S.Read(Flags, SizeOf(Flags));
-  Name:=S.ReadStr;
-  if (Flags and sfHasMemInfo)<>0 then
-    begin
-      S.Read(MI,SizeOf(MI));
-      SetMemInfo(MI);
-    end;
-
-  W:=0;
-  S.Read(W,SizeOf(W));
-  if (W and 1)<>0 then
-    New(References, Load(S));
-  if (W and 2)<>0 then
-    New(Items, Load(S));
-
-  { --- items needing fixup --- }
-  S.Read(DType, SizeOf(DType));
-  S.Read(VType, SizeOf(VType));
-  S.Read(Params, SizeOf(Params));
-end;
-
-procedure TSymbol.Store(var S: TStream);
-var W: word;
-begin
-  S.Write(Typ,SizeOf(Typ));
-  S.Write(TypeID, SizeOf(TypeID));
-  S.Write(RelatedTypeID, SizeOf(RelatedTypeID));
-  S.Write(Flags, SizeOf(Flags));
-  S.WriteStr(Name);
-
-  if (Flags and sfHasMemInfo)<>0 then
-    S.Write(MemInfo^,SizeOf(MemInfo^));
-
-  W:=0;
-  if Assigned(References) then W:=W or 1;
-  if Assigned(Items) then W:=W or 2;
-  S.Write(W,SizeOf(W));
-  if Assigned(References) then References^.Store(S);
-  if Assigned(Items) then Items^.Store(S);
-
-  { --- items needing fixup --- }
-  S.Write(DType, SizeOf(DType));
-  S.Write(VType, SizeOf(VType));
-  S.Write(Params, SizeOf(Params));
-end;
-
-constructor TExport.Init(const AName: string; AIndex: longint; ASymbol: PSymbol);
-begin
-  inherited Init;
-  Name:=NewStr(AName); Index:=AIndex;
-  Symbol:=ASymbol;
-end;
-
-function TExport.GetDisplayText: string;
-var S: string;
-begin
-  S:=GetStr(Name)+' '+IntToStr(Index);
-  if Assigned(Symbol) and (UpcaseStr(Symbol^.GetName)<>UpcaseStr(GetStr(Name))) then
-    S:=S+' ('+Symbol^.GetName+')';
-  GetDisplayText:=S;
-end;
-
-destructor TExport.Done;
-begin
-  if Assigned(Name) then DisposeStr(Name);
-  inherited Done;
-end;
-
-constructor TImport.Init(const ALibName, AFuncName,ARealName: string; AIndex: longint);
-begin
-  inherited Init;
-  LibName:=NewStr(ALibName);
-  FuncName:=NewStr(AFuncName); RealName:=NewStr(ARealName);
-  Index:=AIndex;
-end;
-
-function TImport.GetDisplayText: string;
-var S: string;
-begin
-  S:=GetStr(RealName);
-  if Assigned(FuncName) then S:=GetStr(FuncName)+' ('+S+')';
-  if S='' then S:=IntToStr(Index);
-  S:=GetStr(LibName)+' '+S;
-  GetDisplayText:=S;
-end;
-
-destructor TImport.Done;
-begin
-  if Assigned(LibName) then DisposeStr(LibName);
-  if Assigned(FuncName) then DisposeStr(FuncName);
-  if Assigned(RealName) then DisposeStr(RealName);
-  inherited Done;
-end;
-
-function TImportCollection.At(Index: sw_Integer): PImport;
-begin
-  At:=inherited At(Index);
-end;
-
-function TImportCollection.Compare(Key1, Key2: Pointer): sw_Integer;
-var K1: PImport absolute Key1;
-    K2: PImport absolute Key2;
-    S1: string;
-    S2: string;
-    R: sw_integer;
-begin
-  if (K1^.RealName=nil) and (K2^.RealName<>nil) then R:= 1 else
-  if (K1^.RealName<>nil) and (K2^.RealName=nil) then R:=-1 else
-  if (K1^.RealName=nil) and (K2^.RealName=nil) then
-    begin
-      if K1^.Index<K2^.Index then R:=-1 else
-      if K1^.Index>K2^.Index then R:= 1 else
-      R:=0;
-    end
-  else
-    begin
-      if K1^.FuncName=nil then S1:=GetStr(K1^.RealName) else S1:=GetStr(K1^.FuncName);
-      if K2^.FuncName=nil then S2:=GetStr(K2^.RealName) else S2:=GetStr(K2^.FuncName);
-      S1:=UpcaseStr(S1); S2:=UpcaseStr(S2);
-      if S1<S2 then R:=-1 else
-      if S1>S2 then R:= 1 else
-      R:=0;
-    end;
-  Compare:=R;
-end;
-
-function TExportCollection.At(Index: sw_Integer): PExport;
-begin
-  At:=inherited At(Index);
-end;
-
-function TExportCollection.Compare(Key1, Key2: Pointer): sw_Integer;
-var K1: PExport absolute Key1;
-    K2: PExport absolute Key2;
-    S1: string;
-    S2: string;
-    R: sw_integer;
-begin
-  S1:=UpcaseStr(GetStr(K1^.Name)); S2:=UpcaseStr(GetStr(K2^.Name));
-  if S1<S2 then R:=-1 else
-  if S1>S2 then R:= 1 else
-  R:=0;
-  Compare:=R;
-end;
-
-constructor TModuleSymbol.Init(const AName, AMainSource: string);
-begin
-  inherited Init(AName,unitsym,'',nil);
-  MainSource:=NewStr(AMainSource);
-end;
-
-procedure TModuleSymbol.SetLoadedFrom(const AModuleName: string);
-begin
-  SetStr(LoadedFrom,AModuleName);
-end;
-
-procedure TModuleSymbol.AddUsedUnit(P: PSymbol);
-begin
-  if Assigned(UsedUnits)=false then
-    New(UsedUnits, Init(10,10));
-  UsedUnits^.Insert(P);
-end;
-
-procedure TModuleSymbol.AddDependentUnit(P: PSymbol);
-begin
-  if Assigned(DependentUnits)=false then
-    New(DependentUnits, Init(10,10));
-  DependentUnits^.Insert(P);
-end;
-
-procedure TModuleSymbol.AddSourceFile(const Path: string);
-begin
-  if Assigned(SourceFiles)=false then
-    New(SourceFiles, Init(10,10));
-  sourcefiles^.Insert(NewStr(Path));
-end;
-
-destructor TModuleSymbol.Done;
-begin
-  inherited Done;
-  if Assigned(MainSource) then DisposeStr(MainSource);
-  if assigned(Exports_) then
-    Dispose(Exports_, Done);
-  if Assigned(Imports) then
-    Dispose(Imports, Done);
-  if Assigned(LoadedFrom) then
-    DisposeStr(LoadedFrom);
-  if Assigned(UsedUnits) then
-  begin
-    UsedUnits^.DeleteAll;
-    Dispose(UsedUnits, Done);
-  end;
-  if Assigned(DependentUnits) then
-  begin
-    DependentUnits^.DeleteAll;
-    Dispose(DependentUnits, Done);
-  end;
-  if Assigned(SourceFiles) then Dispose(SourceFiles, Done);
-end;
-
-
-constructor TObjectSymbol.Init(AParent: PObjectSymbol; ASymbol: PSymbol);
-begin
-  inherited Init;
-  Parent:=AParent;
-  Symbol:=ASymbol;
-end;
-
-constructor TObjectSymbol.InitName(const AName: string);
-begin
-  inherited Init;
-  Name:=NewStr(AName);
-end;
-
-function TObjectSymbol.GetName: string;
-begin
-  if Name<>nil then
-    GetName:=Name^
-  else
-    GetName:=Symbol^.GetName;
-end;
-
-function TObjectSymbol.GetDescendantCount: sw_integer;
-var Count: sw_integer;
-begin
-  if Descendants=nil then Count:=0 else
-    Count:=Descendants^.Count;
-  GetDescendantCount:=Count;
-end;
-
-function TObjectSymbol.GetDescendant(Index: sw_integer): PObjectSymbol;
-begin
-  GetDescendant:=Descendants^.At(Index);
-end;
-
-procedure TObjectSymbol.AddDescendant(P: PObjectSymbol);
-begin
-  if Descendants=nil then
-    New(Descendants, Init(50,10));
-  Descendants^.Insert(P);
-end;
-
-destructor TObjectSymbol.Done;
-begin
-  if Assigned(Name) then DisposeStr(Name); Name:=nil;
-  if Assigned(Descendants) then Dispose(Descendants, Done); Descendants:=nil;
-  inherited Done;
-end;
-
-constructor TObjectSymbol.Load(var S: TStream);
-begin
-end;
-
-procedure TObjectSymbol.Store(S: TStream);
-begin
-end;
-
-{****************************************************************************
-                                TSourceFile
-****************************************************************************}
-
-constructor TSourceFile.Init(ASourceFileName, AObjFileName, APPUFileName: string);
-begin
-  inherited Init;
-  SourceFileName:=NewStr(ASourceFileName);
-  ObjFileName:=NewStr(AObjFileName);
-  PPUFileName:=NewStr(APPUFileName);
-end;
-
-destructor TSourceFile.Done;
-begin
-  if assigned(SourceFileName) then DisposeStr(SourceFileName);
-  if assigned(ObjFileName) then DisposeStr(ObjFileName);
-  if assigned(PPUFileName) then DisposeStr(PPUFileName);
-  inherited Done;
-end;
-
-function TSourceFile.GetSourceFilename: string;
-begin
-  GetSourceFilename:=GetStr(SourceFileName);
-end;
-
-function TSourceFile.GetObjFileName: string;
-begin
-  GetObjFilename:=GetStr(ObjFileName);
-end;
-
-function TSourceFile.GetPPUFileName: string;
-begin
-  GetPPUFilename:=GetStr(PPUFileName);
-end;
-
-function TSourceFileCollection.At(Index: sw_Integer): PSourceFile;
-begin
-  At:=inherited At(Index);
-end;
-
-{*****************************************************************************
-                              Main Routines
-*****************************************************************************}
-
-procedure DisposeBrowserCol;
-begin
-  if assigned(Modules) then
-   begin
-     dispose(Modules,Done);
-     Modules:=nil;
-   end;
-  if assigned(ModuleNames) then
-   begin
-     dispose(ModuleNames,Done);
-     ModuleNames:=nil;
-   end;
-  if assigned(TypeNames) then
-   begin
-     dispose(TypeNames,Done);
-     TypeNames:=nil;
-   end;
-  if assigned(ObjectTree) then
-    begin
-      Dispose(ObjectTree, Done);
-      ObjectTree:=nil;
-    end;
-end;
-
-
-procedure NewBrowserCol;
-begin
-  New(Modules, Init(50,50));
-  New(ModuleNames, Init(50,50));
-  New(TypeNames, Init(1000,5000));
-end;
-
-
-  procedure ProcessSymTable(OwnerSym: PSymbol; var Owner: PSymbolCollection; Table: TSymTable);
-  var J: longint;
-      Ref: TRef;
-      Sym: TSym;
-      Symbol: PSymbol;
-      Reference: PReference;
-      inputfile : Tinputfile;
-  procedure SetVType(Symbol: PSymbol; VType: string);
-  begin
-    Symbol^.VType:=TypeNames^.Add(VType);
-  end;
-  procedure SetDType(Symbol: PSymbol; DType: string);
-  begin
-    Symbol^.DType:=TypeNames^.Add(DType);
-  end;
-  function GetDefinitionStr(def: tdef): string; forward;
-  function GetEnumDefStr(def: tenumdef): string;
-  var Name: string;
-      esym: tenumsym;
-      Count: integer;
-  begin
-    Name:='(';
-    esym:=tenumsym(def.Firstenum); Count:=0;
-    while (esym<>nil) do
-      begin
-        if Count>0 then
-          Name:=Name+', ';
-        Name:=Name+esym.name;
-        esym:=esym.nextenum;
-        Inc(Count);
-      end;
-    Name:=Name+')';
-    GetEnumDefStr:=Name;
-  end;
-  function GetArrayDefStr(def: tarraydef): string;
-  var Name: string;
-  begin
-    Name:='array ['+IntToStr(def.lowrange)+'..'+IntToStr(def.highrange)+'] of ';
-    if assigned(def.elementtype.def) then
-      Name:=Name+GetDefinitionStr(def.elementtype.def);
-    GetArrayDefStr:=Name;
-  end;
-  function GetFileDefStr(def: tfiledef): string;
-  var Name: string;
-  begin
-    Name:='';
-    case def.filetyp of
-      ft_text    : Name:='text';
-      ft_untyped : Name:='file';
-      ft_typed   : Name:='file of '+GetDefinitionStr(def.typedfiletype.def);
-    end;
-    GetFileDefStr:=Name;
-  end;
-  function GetStringDefStr(def: tstringdef): string;
-  var Name: string;
-  begin
-    Name:='';
-    case def.string_typ of
-      st_shortstring :
-        if def.len=255 then
-          Name:='shortstring'
-        else
-          Name:='string['+IntToStr(def.len)+']';
-      st_longstring :
-        Name:='longstring';
-      st_ansistring :
-        Name:='ansistring';
-      st_widestring :
-        Name:='widestring';
-    else ;
-    end;
-    GetStringDefStr:=Name;
-  end;
-  function retdefassigned(def: tabstractprocdef): boolean;
-  var OK: boolean;
-  begin
-    OK:=false;
-    if assigned(def.rettype.def) then
-      if UpcaseStr(GetDefinitionStr(def.rettype.def))<>'VOID' then
-        OK:=true;
-    retdefassigned:=OK;
-  end;
-  function GetAbsProcParmDefStr(def: tabstractprocdef): string;
-  var Name: string;
-      dc: tparavarsym;
-      i,
-      Count: integer;
-      CurName: string;
-  begin
-    Name:='';
-    Count:=0;
-    for i:=0 to def.paras.count-1 do
-     begin
-       dc:=tparavarsym(def.paras[i]);
-       if i=0 then
-         CurName:=''
-       else
-         CurName:=', '+CurName;
-       case dc.varspez of
-         vs_Value : ;
-         vs_Const : CurName:=CurName+'const ';
-         vs_Var   : CurName:=CurName+'var ';
-       end;
-       if assigned(dc.vartype.def) then
-         CurName:=CurName+GetDefinitionStr(dc.vartype.def);
-       Name:=CurName+Name;
-       Inc(Count);
-     end;
-    GetAbsProcParmDefStr:=Name;
-  end;
-  function GetAbsProcDefStr(def: tabstractprocdef): string;
-  var Name: string;
-  begin
-    Name:=GetAbsProcParmDefStr(def);
-    if Name<>'' then Name:='('+Name+')';
-    if retdefassigned(def) then
-      Name:='function'+Name+': '+GetDefinitionStr(def.rettype.def)
-    else
-      Name:='procedure'+Name;
-    GetAbsProcDefStr:=Name;
-  end;
-  function GetProcDefStr(def: tprocdef): string;
-  var DName: string;
-      {J: integer;}
-  begin
-{    DName:='';
-    if assigned(def) then
-    begin
-      if assigned(def.parast) then
-        begin
-          with def.parast^ do
-          for J:=1 to number_symbols do
-            begin
-              if J<>1 then DName:=DName+', ';
-              ParSym:=GetsymNr(J);
-              if ParSym=nil then Break;
-              DName:=DName+ParSym^.Name;
-            end;
-        end
-    end;}
-    DName:=GetAbsProcDefStr(def);
-    GetProcDefStr:=DName;
-  end;
-  function GetProcVarDefStr(def: tprocvardef): string;
-  begin
-    GetProcVarDefStr:=GetAbsProcDefStr(def);
-  end;
-  function GetSetDefStr(def: tsetdef): string;
-  var Name: string;
-  begin
-    Name:='';
-    case def.settype of
-      normset  : Name:='set';
-      smallset : Name:='set';
-      varset   : Name:='varset';
-    end;
-    Name:=Name+' of ';
-    Name:=Name+GetDefinitionStr(def.elementtype.def);
-    GetSetDefStr:=Name;
-  end;
-  function GetPointerDefStr(def: tpointerdef): string;
-  begin
-    GetPointerDefStr:='^'+GetDefinitionStr(def.pointertype.def);
-  end;
-  function GetDefinitionStr(def: tdef): string;
-  var Name: string;
-  begin
-    Name:='';
-    if def<>nil then
-    begin
-      if assigned(def.typesym) then
-        Name:=def.typesym.name;
-      if Name='' then
-      case def.deftype of
-        arraydef :
-          Name:=GetArrayDefStr(tarraydef(def));
-        stringdef :
-          Name:=GetStringDefStr(tstringdef(def));
-        enumdef :
-          Name:=GetEnumDefStr(tenumdef(def));
-        procdef :
-          Name:=GetProcDefStr(tprocdef(def));
-        procvardef :
-          Name:=GetProcVarDefStr(tprocvardef(def));
-        filedef :
-          Name:=GetFileDefStr(tfiledef(def));
-        setdef :
-          Name:=GetSetDefStr(tsetdef(def));
-      end;
-    end;
-    GetDefinitionStr:=Name;
-  end;
-  function GetEnumItemName(Sym: tenumsym): string;
-  var Name: string;
-      {ES: tenumsym;}
-  begin
-    Name:='';
-    if assigned(sym) and assigned(sym.definition) then
-      if assigned(sym.definition.typesym) then
-      begin
-{        ES:=sym.definition.First;
-        while (ES<>nil) and (ES^.Value<>sym.value) do
-          ES:=ES^.next;
-        if assigned(es) and (es^.value=sym.value) then
-          Name:=}
-        Name:=sym.definition.typesym.name;
-        if Name<>'' then
-          Name:=Name+'('+IntToStr(sym.value)+')';
-      end;
-    GetEnumItemName:=Name;
-  end;
-  function GetConstValueName(sym: tconstsym): string;
-  var Name: string;
-  begin
-    Name:='';
-    if Name='' then
-    case sym.consttyp of
-      constord :
-        begin
-          if sym.consttype.def.deftype=enumdef then
-            Name:=sym.consttype.def.typesym.name+'('+IntToStr(sym.value.valueord)+')'
-          else
-            if is_boolean(sym.consttype.def) then
-              Name:='Longbool('+IntToStr(sym.value.valueord)+')'
-          else
-            if is_char(sym.consttype.def) or
-               is_widechar(sym.consttype.def) then
-              Name:=''''+chr(sym.value.valueord)+''''
-          else
-            Name:=IntToStr(sym.value.valueord);
-        end;
-      constresourcestring,
-      conststring :
-        Name:=''''+StrPas(pchar(sym.value.valueptr))+'''';
-      constreal:
-        Name:=FloatToStr(PBestReal(sym.value.valueptr)^);
-      constset:
-{        Name:=SetToStr(pnormalset(sym.value.valueptr)) };
-      constnil: ;
-    end;
-    GetConstValueName:=Name;
-  end;
-  procedure ProcessDefIfStruct(definition: tdef);
-  begin
-    { still led to infinite recursions
-      only usefull for unamed types PM }
-    if assigned(definition) and not assigned(definition.typesym) then
-    begin
-      case definition.deftype of
-        recorddef :
-          if trecorddef(definition).symtable<>Table then
-            ProcessSymTable(Symbol,Symbol^.Items,trecorddef(definition).symtable);
-        objectdef :
-          if tobjectdef(definition).symtable<>Table then
-            ProcessSymTable(Symbol,Symbol^.Items,tobjectdef(definition).symtable);
-        { leads to infinite loops !!
-        pointerdef :
-          with tpointerdef(definition)^ do
-            if assigned(definition) then
-              if assigned(definition.sym) then
-                ProcessDefIfStruct(definition.sym.definition);}
-      end;
-    end;
-  end;
-  var MemInfo: TSymbolMemInfo;
-      ObjDef: tobjectdef;
-  begin
-    if not Assigned(Table) then
-     Exit;
-    if Owner=nil then
-     Owner:=New(PSortedSymbolCollection, Init(10,50));
-    sym:=tsym(Table.symindex.first);
-    while assigned(sym) do
-      begin
-        New(Symbol, Init(Sym.Name,Sym.Typ,'',nil));
-        case Sym.Typ of
-          globalvarsym,
-          localvarsym,
-          paravarsym :
-             with tabstractvarsym(sym) do
-             begin
-               if assigned(vartype.def) then
-                 if assigned(vartype.def.typesym) then
-                   SetVType(Symbol,vartype.def.typesym.name)
-                 else
-                   SetVType(Symbol,GetDefinitionStr(vartype.def));
-               ProcessDefIfStruct(vartype.def);
-               if assigned(vartype.def) then
-                 if (vartype.def.deftype=pointerdef) and
-                    assigned(tpointerdef(vartype.def).pointertype.def) then
-                 begin
-                   Symbol^.Flags:=(Symbol^.Flags or sfPointer);
-                   Symbol^.RelatedTypeID:=Ptrint(tpointerdef(vartype.def).pointertype.def);
-                 end;
-               if typ=fieldvarsym then
-                 MemInfo.Addr:=tfieldvarsym(sym).fieldoffset
-               else
-                 begin
-                   if tabstractnormalvarsym(sym).localloc.loc=LOC_REFERENCE then
-                     MemInfo.Addr:=tabstractnormalvarsym(sym).localloc.reference.offset
-                   else
-                     MemInfo.Addr:=0;
-                 end;
-               if assigned(vartype.def) and (vartype.def.deftype=arraydef) then
-                 begin
-                   if tarraydef(vartype.def).highrange<tarraydef(vartype.def).lowrange then
-                     MemInfo.Size:=-1
-                   else
-                     MemInfo.Size:=getsize;
-                 end
-               else
-                 MemInfo.Size:=getsize;
-               { this is not completely correct... }
-               MemInfo.PushSize:=paramanager.push_size(varspez,vartype.def,pocall_default);
-               Symbol^.SetMemInfo(MemInfo);
-             end;
-          fieldvarsym :
-             with tfieldvarsym(sym) do
-             begin
-               if assigned(vartype.def) and (vartype.def.deftype=arraydef) then
-                 begin
-                   if tarraydef(vartype.def).highrange<tarraydef(vartype.def).lowrange then
-                     MemInfo.Size:=-1
-                   else
-                     MemInfo.Size:=getsize;
-                 end
-               else
-                 MemInfo.Size:=getsize;
-               Symbol^.SetMemInfo(MemInfo);
-             end;
-          constsym :
-             SetDType(Symbol,GetConstValueName(tconstsym(sym)));
-          enumsym :
-            if assigned(tenumsym(sym).definition) then
-             SetDType(Symbol,GetEnumItemName(tenumsym(sym)));
-          unitsym :
-            begin
-  {            ProcessSymTable(Symbol^.Items,tunitsym(sym).unitsymtable);}
-            end;
-          syssym :
-{            if assigned(Table.Name) then
-            if Table.Name^='SYSTEM' then}
-              begin
-                Symbol^.Params:=TypeNames^.Add('...');
-              end;
-          procsym :
-            begin
-              with tprocsym(sym) do
-              if assigned(first_procdef) then
-              begin
-                if cs_local_browser in aktmoduleswitches then
-                  ProcessSymTable(Symbol,Symbol^.Items,first_procdef.parast);
-                if assigned(first_procdef.parast) then
-                  begin
-                    Symbol^.Params:=TypeNames^.Add(GetAbsProcParmDefStr(first_procdef));
-                  end
-                else { param-definition is NOT assigned }
-                  if assigned(Table.Name) then
-                  if Table.Name^='SYSTEM' then
-                  begin
-                    Symbol^.Params:=TypeNames^.Add('...');
-                  end;
-                if cs_local_browser in aktmoduleswitches then
-                 begin
-                   if assigned(first_procdef.localst) and
-                     (first_procdef.localst.symtabletype<>staticsymtable) then
-                    ProcessSymTable(Symbol,Symbol^.Items,first_procdef.localst);
-                 end;
-              end;
-            end;
-          typesym :
-            begin
-            with ttypesym(sym) do
-              if assigned(restype.def) then
-               begin
-                Symbol^.TypeID:=Ptrint(restype.def);
-                case restype.def.deftype of
-                  arraydef :
-                    SetDType(Symbol,GetArrayDefStr(tarraydef(restype.def)));
-                  enumdef :
-                    SetDType(Symbol,GetEnumDefStr(tenumdef(restype.def)));
-                  procdef :
-                    SetDType(Symbol,GetProcDefStr(tprocdef(restype.def)));
-                  procvardef :
-                    SetDType(Symbol,GetProcVarDefStr(tprocvardef(restype.def)));
-                  objectdef :
-                    with tobjectdef(restype.def) do
-                    begin
-                      ObjDef:=childof;
-                      if ObjDef<>nil then
-                        Symbol^.RelatedTypeID:=Ptrint(ObjDef);{TypeNames^.Add(S);}
-                      Symbol^.Flags:=(Symbol^.Flags or sfObject);
-                      if tobjectdef(restype.def).objecttype=odt_class then
-                        Symbol^.Flags:=(Symbol^.Flags or sfClass);
-                      ProcessSymTable(Symbol,Symbol^.Items,tobjectdef(restype.def).symtable);
-                    end;
-                  recorddef :
-                    begin
-                      Symbol^.Flags:=(Symbol^.Flags or sfRecord);
-                      ProcessSymTable(Symbol,Symbol^.Items,trecorddef(restype.def).symtable);
-                    end;
-                  pointerdef :
-                    begin
-                      Symbol^.Flags:=(Symbol^.Flags or sfPointer);
-                      Symbol^.RelatedTypeID:=Ptrint(tpointerdef(restype.def).pointertype.def);{TypeNames^.Add(S);}
-                      SetDType(Symbol,GetPointerDefStr(tpointerdef(restype.def)));
-                    end;
-
-                  filedef :
-                    SetDType(Symbol,GetFileDefStr(tfiledef(restype.def)));
-                  setdef :
-                    SetDType(Symbol,GetSetDefStr(tsetdef(restype.def)));
-                end;
-               end;
-            end;
-        end;
-        Ref:=tstoredsym(sym).defref;
-        while Assigned(Symbol) and assigned(Ref) do
-          begin
-            inputfile:=get_source_file(ref.moduleindex,ref.posinfo.fileindex);
-            if Assigned(inputfile) and Assigned(inputfile.name) then
-              begin
-                New(Reference, Init(ModuleNames^.Add(inputfile.name^),
-                  ref.posinfo.line,ref.posinfo.column));
-                Symbol^.References^.Insert(Reference);
-              end;
-            Ref:=Ref.nextref;
-          end;
-        if Assigned(Symbol) then
-          begin
-            if not Owner^.Search(Symbol,J) then
-              Owner^.Insert(Symbol)
-            else
-              begin
-                Dispose(Symbol,done);
-                Symbol:=nil;
-              end;
-          end;
-        sym:=tsym(sym.indexnext);
-      end;
-  end;
-
-function SearchModule(const Name: string): PModuleSymbol;
-function Match(P: PModuleSymbol): boolean; {$ifndef FPC}far;{$endif}
-begin
-  Match:=CompareText(P^.GetName,Name)=0;
-end;
-var P: PModuleSymbol;
-begin
-  P:=nil;
-  if Assigned(Modules) then
-    P:=Modules^.FirstThat(@Match);
-  SearchModule:=P;
-end;
-
-procedure CreateBrowserCol;
-var
-  T: TSymTable;
-  UnitS,PM: PModuleSymbol;
-  hp : tmodule;
-  puu: tused_unit;
-  pdu: tdependent_unit;
-  pif: tinputfile;
-begin
-  DisposeBrowserCol;
-  if (cs_browser in aktmoduleswitches) then
-    NewBrowserCol;
-  hp:=tmodule(loaded_units.first);
-  if (cs_browser in aktmoduleswitches) then
-   while assigned(hp) do
-    begin
-       t:=tsymtable(hp.globalsymtable);
-       if assigned(t) then
-         begin
-           New(UnitS, Init(T.Name^,hp.mainsource^));
-           if Assigned(hp.loaded_from) then
-             if assigned(hp.loaded_from.globalsymtable) then
-               UnitS^.SetLoadedFrom(tsymtable(hp.loaded_from.globalsymtable).name^);
-{           pimportlist(current_module^.imports^.first);}
-
-           if assigned(hp.sourcefiles) then
-           begin
-             pif:=hp.sourcefiles.files;
-             while (pif<>nil) do
-             begin
-               UnitS^.AddSourceFile(pif.path^+pif.name^);
-               pif:=pif.next;
-             end;
-           end;
-
-           Modules^.Insert(UnitS);
-           ProcessSymTable(UnitS,UnitS^.Items,T);
-           if cs_local_browser in aktmoduleswitches then
-             begin
-                t:=tsymtable(hp.localsymtable);
-                if assigned(t) then
-                  ProcessSymTable(UnitS,UnitS^.Items,T);
-             end;
-         end;
-       hp:=tmodule(hp.next);
-    end;
-
-  hp:=tmodule(loaded_units.first);
-  if (cs_browser in aktmoduleswitches) then
-   while assigned(hp) do
-    begin
-       t:=tsymtable(hp.globalsymtable);
-       if assigned(t) then
-         begin
-           UnitS:=SearchModule(T.Name^);
-           puu:=tused_unit(hp.used_units.first);
-           while (puu<>nil) do
-           begin
-             PM:=SearchModule(puu.u.modulename^);
-             if Assigned(PM) then
-               UnitS^.AddUsedUnit(PM);
-             puu:=tused_unit(puu.next);
-           end;
-           pdu:=tdependent_unit(hp.dependent_units.first);
-           while (pdu<>nil) do
-           begin
-             PM:=SearchModule(tsymtable(pdu.u.globalsymtable).name^);
-             if Assigned(PM) then
-               UnitS^.AddDependentUnit(PM);
-             pdu:=tdependent_unit(pdu.next);
-           end;
-         end;
-       hp:=tmodule(hp.next);
-    end;
-
-  if (cs_browser in aktmoduleswitches) then
-    BuildObjectInfo;
-  { can allways be done
-    needed to know when recompilation of sources is necessary }
-  BuildSourceList;
-end;
-
-procedure BuildObjectInfo;
-var C,D: PIDSortedSymbolCollection;
-    E : PCollection;
-    ObjectC: PObjectSymbolCollection;
-    ObjectsSymbol: PObjectSymbol;
-procedure InsertSymbolCollection(Symbols: PSymbolCollection);
-var I: sw_integer;
-    P: PSymbol;
-begin
-  for I:=0 to Symbols^.Count-1 do
-    begin
-      P:=Symbols^.At(I);
-      if (P^.Flags and sfObject)<>0 then
-        C^.Insert(P);
-      if (P^.typ=typesym) then
-        D^.Insert(P);
-      if (P^.typ in [globalvarsym,localvarsym,paravarsym]) and ((P^.flags and sfPointer)<>0) then
-        E^.Insert(P);
-      if P^.Items<>nil then
-        InsertSymbolCollection(P^.Items);
-    end;
-end;
-function SearchObjectForSym(O: PSymbol): PObjectSymbol;
-var I: sw_integer;
-    OS,P: PObjectSymbol;
-begin
-  P:=nil;
-  for I:=0 to ObjectC^.Count-1 do
-    begin
-      OS:=ObjectC^.At(I);
-      if OS^.Symbol=O then
-        begin P:=OS; Break; end;
-    end;
-  SearchObjectForSym:=P;
-end;
-procedure BuildTree;
-var I: sw_integer;
-    Symbol: PSymbol;
-    Parent,OS: PObjectSymbol;
-begin
-  I:=0;
-  while (I<C^.Count) do
-    begin
-      Symbol:=C^.At(I);
-      if Symbol^.Ancestor=nil then
-        Parent:=ObjectsSymbol
-      else
-        Parent:=SearchObjectForSym(Symbol^.Ancestor);
-      if Parent<>nil then
-        begin
-          New(OS, Init(Parent, Symbol));
-          Parent^.AddDescendant(OS);
-          ObjectC^.Insert(OS);
-          C^.AtDelete(I);
-        end
-      else
-        Inc(I);
-    end;
-end;
-var Pass: integer;
-    I: sw_integer;
-    P: PSymbol;
-begin
-  New(C, Init(1000,5000));
-  New(D, Init(1000,5000));
-  New(E, Init(1000,5000));
-  InsertSymbolCollection(Modules);
-
-  { --- Resolve ancestor<->descendant references --- }
-  for I:=0 to C^.Count-1 do
-    begin
-      P:=C^.At(I);
-      if P^.RelatedTypeID<>0 then
-        P^.Ancestor:=C^.SearchSymbolByID(P^.RelatedTypeID);
-    end;
-
-  { --- Resolve pointer definition references --- }
-  for I:=0 to D^.Count-1 do
-    begin
-      P:=D^.At(I);
-      if P^.RelatedTypeID<>0 then
-        P^.Ancestor:=D^.SearchSymbolByID(P^.RelatedTypeID);
-    end;
-
-  { --- Resolve  pointer var definition references --- }
-  for I:=0 to E^.Count-1 do
-    begin
-      P:=PSymbol(E^.At(I));
-      if P^.RelatedTypeID<>0 then
-        P^.Ancestor:=D^.SearchSymbolByID(P^.RelatedTypeID);
-    end;
-
-  { E is not needed anymore }
-  E^.DeleteAll;
-  Dispose(E,Done);
-
-  { D is not needed anymore }
-  D^.DeleteAll;
-  Dispose(D,Done);
-
-  { --- Build object tree --- }
-  if assigned(ObjectTree) then
-    Dispose(ObjectTree, Done);
-  New(ObjectsSymbol, InitName('Objects'));
-  ObjectTree:=ObjectsSymbol;
-
-  New(ObjectC, Init(C^.Count,100));
-
-  Pass:=0;
-  if C^.Count>0 then
-  repeat
-    BuildTree;
-    Inc(Pass);
-  until (C^.Count=0) or (Pass>20); { more than 20 levels ? - then there must be a bug }
-
-  ObjectC^.DeleteAll; Dispose(ObjectC, Done);
-  C^.DeleteAll; Dispose(C, Done);
-end;
-
-function SearchObjectForSymbol(O: PSymbol): PObjectSymbol;
-function ScanObjectCollection(Parent: PObjectSymbol): PObjectSymbol;
-var I: sw_integer;
-    OS,P: PObjectSymbol;
-    ObjectC: PObjectSymbolCollection;
-begin
-  P:=nil;
-  if Parent<>nil then
-  if Parent^.Descendants<>nil then
-  begin
-    ObjectC:=Parent^.Descendants;
-    for I:=0 to ObjectC^.Count-1 do
-      begin
-        OS:=ObjectC^.At(I);
-        if OS^.Symbol=O then
-          begin P:=OS; Break; end;
-        if OS^.Descendants<>nil then
-          begin
-            P:=ScanObjectCollection(OS);
-            if P<>nil then Break;
-          end;
-      end;
-  end;
-  ScanObjectCollection:=P;
-end;
-begin
-  SearchObjectForSymbol:=ScanObjectCollection(ObjectTree);
-end;
-
-procedure BuildSourceList;
-var m: tmodule;
-    s: tinputfile;
-    p: cutils.pstring;
-    ppu,obj: string;
-    source: string;
-begin
-  if Assigned(SourceFiles) then
-    begin
-      Dispose(SourceFiles, Done);
-      SourceFiles:=nil;
-    end;
-  if assigned(loaded_units.first) then
-  begin
-    New(SourceFiles, Init(50,10));
-    m:=tmodule(loaded_units.first);
-    while assigned(m) do
-    begin
-      obj:=fexpand(m.objfilename^);
-      ppu:=''; source:='';
-      if m.is_unit then
-        ppu:=fexpand(m.ppufilename^);
-      if (m.is_unit=false) and (m.islibrary=false) then
-        ppu:=fexpand(m.exefilename^);
-      if assigned(m.sourcefiles) then
-        begin
-          s:=m.sourcefiles.files;
-          while assigned(s) do
-          begin
-            source:='';
-            p:=s.path;
-            if assigned(p) then
-              source:=source+p^;
-            p:=s.name;
-            if assigned(p) then
-              source:=source+p^;
-            source:=fexpand(source);
-
-            sourcefiles^.Insert(New(PSourceFile, Init(source,obj,ppu)));
-            s:=s.ref_next;
-          end;
-        end;
-      m:=tmodule(m.next);
-    end;
-  end;
-end;
-
-{*****************************************************************************
-                                 Initialize
-*****************************************************************************}
-
-
-
-var
-  oldexit : pointer;
-
-procedure browcol_exit;{$ifndef FPC}far;{$endif}
-begin
-  exitproc:=oldexit;
-  DisposeBrowserCol;
-  if Assigned(SourceFiles) then
-    begin
-      Dispose(SourceFiles, Done);
-      SourceFiles:=nil;
-    end;
-  if assigned(ObjectTree) then
-    begin
-      Dispose(ObjectTree, Done);
-      ObjectTree:=nil;
-    end;
-end;
-
-
-procedure InitBrowserCol;
-begin
-end;
-
-
-procedure DoneBrowserCol;
-begin
-  { nothing, the collections are freed in the exitproc - ??? }
-  { nothing? then why do we've this routine for ? IMHO, either we should
-    remove this, or it should destroy the browser info when it's called. - BG }
-end;
-
-type
-     PPointerXRef = ^TPointerXRef;
-     TPointerXRef = record
-       PtrValue : pointer;
-       DataPtr  : pointer;
-     end;
-
-     PPointerDictionary = ^TPointerDictionary;
-     TPointerDictionary = object(TSortedCollection)
-       function  At(Index: sw_Integer): PPointerXRef;
-       function  Compare(Key1, Key2: Pointer): sw_Integer; virtual;
-       procedure FreeItem(Item: Pointer); virtual;
-       function  SearchXRef(PtrValue: pointer): PPointerXRef;
-       function  AddPtr(PtrValue, DataPtr: pointer): PPointerXRef;
-       procedure Resolve(var P);
-     end;
-
-function NewPointerXRef(APtrValue, ADataPtr: pointer): PPointerXRef;
-var P: PPointerXRef;
-begin
-  New(P); FillChar(P^,SizeOf(P^),0);
-  with P^ do begin PtrValue:=APtrValue; DataPtr:=ADataPtr; end;
-  NewPointerXRef:=P;
-end;
-
-procedure DisposePointerXRef(P: PPointerXRef);
-begin
-  if Assigned(P) then Dispose(P);
-end;
-
-function TPointerDictionary.At(Index: sw_Integer): PPointerXRef;
-begin
-  At:=inherited At(Index);
-end;
-
-function TPointerDictionary.Compare(Key1, Key2: Pointer): sw_Integer;
-var K1: PPointerXRef absolute Key1;
-    K2: PPointerXRef absolute Key2;
-    R: integer;
-begin
-  if Ptrint(K1^.PtrValue)<Ptrint(K2^.PtrValue) then R:=-1 else
-  if Ptrint(K1^.PtrValue)>Ptrint(K2^.PtrValue) then R:= 1 else
-  R:=0;
-  Compare:=R;
-end;
-
-procedure TPointerDictionary.FreeItem(Item: Pointer);
-begin
-  if Assigned(Item) then DisposePointerXRef(Item);
-end;
-
-function TPointerDictionary.SearchXRef(PtrValue: pointer): PPointerXRef;
-var P: PPointerXRef;
-    T: TPointerXRef;
-    Index: sw_integer;
-begin
-  T.PtrValue:=PtrValue;
-  if Search(@T,Index)=false then P:=nil else
-    P:=At(Index);
-  SearchXRef:=P;
-end;
-
-function TPointerDictionary.AddPtr(PtrValue, DataPtr: pointer): PPointerXRef;
-var P: PPointerXRef;
-begin
-  P:=SearchXRef(PtrValue);
-  if P=nil then
-    begin
-      P:=NewPointerXRef(PtrValue,DataPtr);
-      Insert(P);
-{$ifdef DEBUG}
-    end
-  else
-    begin
-      if P^.DataPtr<>DataPtr then
-        InternalError(987654);
-{$endif DEBUG}
-    end;
-  AddPtr:=P;
-end;
-
-procedure TPointerDictionary.Resolve(var P);
-var X: PPointerXRef;
-    V: pointer;
-begin
-  Move(P,V,SizeOf(V));
-  X:=SearchXRef(V);
-  if X=nil then V:=nil else
-    V:=X^.DataPtr;
-  Move(V,P,SizeOf(V));
-end;
-
-procedure ReadPointers(S: PStream; C: PCollection; D: PPointerDictionary);
-var W,I: sw_integer;
-    P: pointer;
-begin
-  S^.Read(W,SizeOf(W));
-  for I:=0 to W-1 do
-  begin
-    S^.Read(P,SizeOf(P));
-    D^.AddPtr(P,C^.At(I));
-  end;
-end;
-
-function LoadBrowserCol(S: PStream): boolean;
-var PD: PPointerDictionary;
-procedure FixupPointers;
-procedure FixupReference(P: PReference); {$ifndef FPC}far;{$endif}
-begin
-  PD^.Resolve(P^.FileName);
-end;
-procedure FixupSymbol(P: PSymbol); {$ifndef FPC}far;{$endif}
-var I: sw_integer;
-begin
-  PD^.Resolve(P^.DType);
-  PD^.Resolve(P^.VType);
-  PD^.Resolve(P^.Params);
-  if Assigned(P^.References) then
-    with P^.References^ do
-     for I:=0 to Count-1 do
-       FixupReference(At(I));
-  if Assigned(P^.Items) then
-    with P^.Items^ do
-     for I:=0 to Count-1 do
-       FixupSymbol(At(I));
-end;
-begin
-  Modules^.ForEach(@FixupSymbol);
-end;
-procedure ReadSymbolPointers(P: PSymbol); {$ifndef FPC}far;{$endif}
-var I: sw_integer;
-    PV: pointer;
-begin
-  S^.Read(PV, SizeOf(PV));
-  PD^.AddPtr(PV,P);
-  if Assigned(P^.Items) then
-    with P^.Items^ do
-     for I:=0 to Count-1 do
-       ReadSymbolPointers(At(I));
-end;
-begin
-  DisposeBrowserCol;
-
-  New(ModuleNames, Load(S^));
-  New(TypeNames, Load(S^));
-  New(Modules, Load(S^));
-
-  New(PD, Init(4000,1000));
-  ReadPointers(S,ModuleNames,PD);
-  ReadPointers(S,TypeNames,PD);
-  ReadPointers(S,Modules,PD);
-  Modules^.ForEach(@ReadSymbolPointers);
-  FixupPointers;
-  Dispose(PD, Done);
-
-  BuildObjectInfo;
-  LoadBrowserCol:=(S^.Status=stOK);
-end;
-
-procedure StorePointers(S: PStream; C: PCollection);
-var W,I: sw_integer;
-    P: pointer;
-begin
-  W:=C^.Count;
-  S^.Write(W,SizeOf(W));
-  for I:=0 to W-1 do
-  begin
-    P:=C^.At(I);
-    S^.Write(P,SizeOf(P));
-  end;
-end;
-
-function StoreBrowserCol(S: PStream) : boolean;
-procedure WriteSymbolPointers(P: PSymbol); {$ifndef FPC}far;{$endif}
-var I: sw_integer;
-begin
-  S^.Write(P, SizeOf(P));
-  if Assigned(P^.Items) then
-    with P^.Items^ do
-     for I:=0 to Count-1 do
-       WriteSymbolPointers(At(I));
-end;
-begin
-  ModuleNames^.Store(S^);
-  TypeNames^.Store(S^);
-  Modules^.Store(S^);
-
-  StorePointers(S,ModuleNames);
-  StorePointers(S,TypeNames);
-  StorePointers(S,Modules);
-  Modules^.ForEach(@WriteSymbolPointers);
-  StoreBrowserCol:=(S^.Status=stOK);
-end;
-
-procedure RegisterSymbols;
-begin
-  RegisterType(RModuleNameCollection);
-  RegisterType(RTypeNameCollection);
-  RegisterType(RReference);
-  RegisterType(RSymbol);
-  RegisterType(RObjectSymbol);
-  RegisterType(RSymbolCollection);
-  RegisterType(RSortedSymbolCollection);
-  RegisterType(RIDSortedSymbolCollection);
-  RegisterType(RObjectSymbolCollection);
-  RegisterType(RReferenceCollection);
-  RegisterType(RModuleSymbol);
-end;
-
-begin
-  oldexit:=exitproc;
-  exitproc:=@browcol_exit;
-end.

compiler/compiler/browlog.pas

@@ -1,515 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl and Pierre Muller
-
-    Support routines for creating the browser log
-
-    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 browlog;
-
-{$i fpcdefs.inc}
-
-interface
-uses
-  cclasses,
-  globtype,
-  fmodule,finput,
-  symbase,symconst,symtype,symsym,symdef,symtable;
-
-const
-  logbufsize   = 16384;
-
-type
-  pbrowserlog=^tbrowserlog;
-  tbrowserlog=object
-    fname    : string;
-    logopen  : boolean;
-    stderrlog : boolean;
-    f        : file;
-    elements_to_list : tstringlist;
-    buf      : pchar;
-    bufidx   : longint;
-    identidx : longint;
-    constructor init;
-    destructor done;
-    procedure setfilename(const fn:string);
-    procedure createlog;
-    procedure flushlog;
-    procedure addlog(const s:string);
-    procedure addlogrefs(p:tref);
-    procedure closelog;
-    procedure ident;
-    procedure unident;
-    procedure browse_symbol(const sr : string);
-    procedure list_elements;
-    procedure list_debug_infos;
-  end;
-
-var
-  browserlog : tbrowserlog;
-
-  procedure WriteBrowserLog;
-
-  procedure InitBrowserLog;
-  procedure DoneBrowserLog;
-
-
-implementation
-
-  uses
-    cutils,comphook,
-    globals,systems,
-    ppu;
-
-    function get_file_line(ref:tref): string;
-      var
-         inputfile : tinputfile;
-      begin
-        get_file_line:='';
-        with ref do
-         begin
-           inputfile:=get_source_file(moduleindex,posinfo.fileindex);
-           if assigned(inputfile) then
-             if status.use_gccoutput then
-             { for use with rhide
-               add warning so that it does not interpret
-               this as an error !! }
-               get_file_line:=lower(inputfile.name^)
-                 +':'+tostr(posinfo.line)+': warning: '+tostr(posinfo.column)+':'
-             else
-               get_file_line:=inputfile.name^
-                 +'('+tostr(posinfo.line)+','+tostr(posinfo.column)+')'
-           else
-             if status.use_gccoutput then
-               get_file_line:='file_unknown:'
-                 +tostr(posinfo.line)+': warning: '+tostr(posinfo.column)+':'
-             else
-               get_file_line:='file_unknown('
-                 +tostr(posinfo.line)+','+tostr(posinfo.column)+')'
-         end;
-      end;
-
-{****************************************************************************
-                              TBrowser
-****************************************************************************}
-
-    constructor tbrowserlog.init;
-      begin
-        fname:=FixFileName('browser.log');
-        logopen:=false;
-        elements_to_list:=TStringList.Create;
-      end;
-
-
-    destructor tbrowserlog.done;
-      begin
-        if logopen then
-         closelog;
-        elements_to_list.free;
-      end;
-
-
-    procedure tbrowserlog.setfilename(const fn:string);
-      begin
-        fname:=FixFileName(fn);
-      end;
-
-
-    procedure tbrowserlog.createlog;
-      begin
-        if logopen then
-         closelog;
-        assign(f,fname);
-        {$I-}
-         rewrite(f,1);
-        {$I+}
-        if ioresult<>0 then
-         exit;
-        logopen:=true;
-        getmem(buf,logbufsize);
-        bufidx:=0;
-        identidx:=0;
-      end;
-
-
-    procedure tbrowserlog.flushlog;
-      begin
-        if logopen then
-         if not stderrlog then
-           blockwrite(f,buf^,bufidx)
-         else
-           begin
-             buf[bufidx]:=#0;
-{$ifdef FPC}
-             write(stderr,buf);
-{$else FPC}
-             write(buf);
-{$endif FPC}
-           end;
-        bufidx:=0;
-      end;
-
-
-    procedure tbrowserlog.closelog;
-      begin
-        if logopen then
-         begin
-           flushlog;
-           close(f);
-           freemem(buf,logbufsize);
-           logopen:=false;
-         end;
-      end;
-
-    procedure tbrowserlog.list_elements;
-
-      begin
-
-         stderrlog:=true;
-         getmem(buf,logbufsize);
-         logopen:=true;
-         while not elements_to_list.empty do
-           browse_symbol(elements_to_list.getfirst);
-         flushlog;
-         logopen:=false;
-         freemem(buf,logbufsize);
-         stderrlog:=false;
-      end;
-
-    procedure tbrowserlog.list_debug_infos;
-{$ifndef debug}
-      begin
-      end;
-{$else debug}
-      var
-         hp : tmodule;
-         ff : tinputfile;
-      begin
-         hp:=tmodule(loaded_units.first);
-         while assigned(hp) do
-           begin
-              addlog('Unit '+hp.modulename^+' has index '+tostr(hp.unit_index));
-              ff:=hp.sourcefiles.files;
-              while assigned(ff) do
-                begin
-                   addlog('File '+ff.name^+' index '+tostr(ff.ref_index));
-                   ff:=ff.ref_next;
-                end;
-              hp:=tmodule(hp.next);
-           end;
-      end;
-{$endif debug}
-
-    procedure tbrowserlog.addlog(const s:string);
-      begin
-        if not logopen then
-         exit;
-      { add ident }
-        if (identidx>0) and not stderrlog then
-         begin
-           if bufidx+identidx>logbufsize then
-            flushlog;
-           fillchar(buf[bufidx],identidx,' ');
-           inc(bufidx,identidx);
-         end;
-      { add text }
-        if bufidx+length(s)>logbufsize-2 then
-         flushlog;
-        move(s[1],buf[bufidx],length(s));
-        inc(bufidx,length(s));
-      { add crlf }
-        buf[bufidx]:=target_info.newline[1];
-        inc(bufidx);
-        if length(target_info.newline)=2 then
-         begin
-           buf[bufidx]:=target_info.newline[2];
-           inc(bufidx);
-         end;
-      end;
-
-
-    procedure tbrowserlog.addlogrefs(p:tref);
-      var
-        ref : tref;
-      begin
-        ref:=p;
-        Ident;
-        while assigned(ref) do
-         begin
-           Browserlog.AddLog(get_file_line(ref));
-           ref:=ref.nextref;
-         end;
-        Unident;
-      end;
-
-
-    procedure tbrowserlog.browse_symbol(const sr : string);
-      var
-         sym  : tsym;
-         symb : tstoredsym;
-         symt : tsymtable;
-         hp : tmodule;
-         s,ss : string;
-         p : byte;
-
-         procedure next_substring;
-           begin
-              p:=pos('.',s);
-              if p>0 then
-                begin
-                   ss:=copy(s,1,p-1);
-                   s:=copy(s,p+1,255);
-                end
-              else
-                begin
-                  ss:=s;
-                  s:='';
-                end;
-              addlog('substring : '+ss);
-          end;
-      begin
-         { don't create a new reference when
-          looking for the symbol !! }
-         make_ref:=false;
-         s:=sr;
-         symt:=symtablestack;
-         next_substring;
-         if assigned(symt) then
-           begin
-              sym:=tstoredsym(symt.search(ss));
-              if sym=nil then
-                sym:=tstoredsym(symt.search(upper(ss)));
-           end
-         else
-           sym:=nil;
-         if assigned(sym) and (sym.typ=unitsym) and (s<>'') then
-           begin
-              addlog('Unitsym found !');
-              symt:=tunitsym(sym).unitsymtable;
-              if assigned(symt) then
-                begin
-                   next_substring;
-                   sym:=tstoredsym(symt.search(ss));
-                end
-              else
-                sym:=nil;
-           end;
-         if not assigned(sym) then
-           begin
-              symt:=nil;
-              { try all loaded_units }
-              hp:=tmodule(loaded_units.first);
-              while assigned(hp) do
-                begin
-                   if hp.modulename^=upper(ss) then
-                     begin
-                        symt:=hp.globalsymtable;
-                        break;
-                     end;
-                   hp:=tmodule(hp.next);
-                end;
-              if not assigned(symt) then
-                begin
-                   addlog('!!!Symbol '+ss+' not found !!!');
-                   make_ref:=true;
-                   exit;
-                end
-              else
-                begin
-                   next_substring;
-                   sym:=tstoredsym(symt.search(ss));
-                   if sym=nil then
-                     sym:=tstoredsym(symt.search(upper(ss)));
-                end;
-           end;
-
-         while assigned(sym) and (s<>'') do
-           begin
-              next_substring;
-              case sym.typ of
-                typesym :
-                  begin
-                     if ttypesym(sym).restype.def.deftype in [recorddef,objectdef] then
-                       begin
-                          if ttypesym(sym).restype.def.deftype=recorddef then
-                            symt:=trecorddef(ttypesym(sym).restype.def).symtable
-                          else
-                            symt:=tobjectdef(ttypesym(sym).restype.def).symtable;
-                          sym:=tstoredsym(symt.search(ss));
-                          if sym=nil then
-                            sym:=tstoredsym(symt.search(upper(ss)));
-                       end;
-                  end;
-                globalvarsym,
-                localvarsym,
-                paravarsym,
-                fieldvarsym :
-                  begin
-                     if tabstractvarsym(sym).vartype.def.deftype in [recorddef,objectdef] then
-                       begin
-                          symt:=tabstractvarsym(sym).vartype.def.getsymtable(gs_record);
-                          sym:=tstoredsym(symt.search(ss));
-                          if sym=nil then
-                            sym:=tstoredsym(symt.search(upper(ss)));
-                       end;
-                  end;
-                procsym :
-                  begin
-                     symt:=tprocsym(sym).first_procdef.parast;
-                     symb:=tstoredsym(symt.search(ss));
-                     if symb=nil then
-                       symb:=tstoredsym(symt.search(upper(ss)));
-                     if not assigned(symb) then
-                       begin
-                          symt:=tprocsym(sym).first_procdef.localst;
-                          sym:=tstoredsym(symt.search(ss));
-                          if symb=nil then
-                            symb:=tstoredsym(symt.search(upper(ss)));
-                       end
-                     else
-                       sym:=symb;
-                  end;
-                end;
-           end;
-           if assigned(sym) then
-            begin
-              if assigned(sym.defref) then
-               begin
-                 browserlog.AddLog('***'+sym.name+'***');
-                 browserlog.AddLogRefs(sym.defref);
-               end;
-            end
-           else
-             addlog('!!!Symbol '+ss+' not found !!!');
-           make_ref:=true;
-      end;
-
-    procedure tbrowserlog.ident;
-      begin
-        inc(identidx,2);
-      end;
-
-
-    procedure tbrowserlog.unident;
-      begin
-        dec(identidx,2);
-      end;
-
-    procedure writesymtable(p:Tsymtable);forward;
-
-    procedure writelocalsymtables(p:Tprocdef;arg:pointer);
-
-    begin
-        if assigned(p.defref) then
-            begin
-                browserlog.AddLog('***'+p.mangledname);
-                browserlog.AddLogRefs(p.defref);
-                if (current_module.flags and uf_local_browser)<>0 then
-                    begin
-                        if assigned(p.parast) then
-                            writesymtable(p.parast);
-                        if assigned(p.localst) then
-                            writesymtable(p.localst);
-                    end;
-             end;
-    end;
-
-
-    procedure writesymtable(p:tsymtable);
-      var
-        hp : tsym;
-        prdef : pprocdeflist;
-      begin
-        if cs_browser in aktmoduleswitches then
-         begin
-           if assigned(p.name) then
-             Browserlog.AddLog('---Symtable '+p.name^)
-           else
-             begin
-                if (p.symtabletype=recordsymtable) and
-                   assigned(tdef(p.defowner).typesym) then
-                  Browserlog.AddLog('---Symtable '+tdef(p.defowner).typesym.name)
-                else
-                  Browserlog.AddLog('---Symtable with no name');
-             end;
-           Browserlog.Ident;
-           hp:=tstoredsym(p.symindex.first);
-           while assigned(hp) do
-            begin
-              if assigned(hp.defref) then
-               begin
-                 browserlog.AddLog('***'+hp.name+'***');
-                 browserlog.AddLogRefs(hp.defref);
-               end;
-              case hp.typ of
-                typesym :
-                  begin
-                    if (ttypesym(hp).restype.def.deftype=recorddef) then
-                      writesymtable(trecorddef(ttypesym(hp).restype.def).symtable);
-                    if (ttypesym(hp).restype.def.deftype=objectdef) then
-                      writesymtable(tobjectdef(ttypesym(hp).restype.def).symtable);
-                  end;
-                procsym :
-                    Tprocsym(hp).foreach_procdef_static(@writelocalsymtables,nil);
-              end;
-              hp:=tstoredsym(hp.indexnext);
-            end;
-           browserlog.Unident;
-         end;
-      end;
-
-
-{****************************************************************************
-                             Helpers
-****************************************************************************}
-
-   procedure WriteBrowserLog;
-     var
-       p : tstoredsymtable;
-       hp : tmodule;
-     begin
-       browserlog.CreateLog;
-       browserlog.list_debug_infos;
-       hp:=tmodule(loaded_units.first);
-       while assigned(hp) do
-         begin
-            p:=tstoredsymtable(hp.globalsymtable);
-            if assigned(p) then
-              writesymtable(p);
-            if cs_local_browser in aktmoduleswitches then
-              begin
-                 p:=tstoredsymtable(hp.localsymtable);
-                 if assigned(p) then
-                   writesymtable(p);
-              end;
-            hp:=tmodule(hp.next);
-         end;
-       browserlog.CloseLog;
-     end;
-
-
-  procedure InitBrowserLog;
-    begin
-       browserlog.init;
-    end;
-
-  procedure DoneBrowserLog;
-    begin
-       browserlog.done;
-    end;
-
-end.

compiler/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/compiler/catch.pas

@@ -1,92 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Michael Van Canneyt
-
-    Unit to catch segmentation faults and Ctrl-C and exit gracefully
-    under linux and go32v2
-
-    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 catch;
-
-{$i fpcdefs.inc}
-
-{$ifdef DEBUG}
-  {$define NOCATCH}
-{$endif DEBUG}
-
-interface
-uses
-{$ifdef unix}
- {$ifndef beos}
-  {$define has_signal}
-  {$ifdef havelinuxrtl10}
-    Linux,
-  {$else}
-    BaseUnix,Unix,
-  {$endif}
- {$endif}
-{$endif}
-{$ifdef go32v2}
-{$define has_signal}
-  dpmiexcp,
-{$endif}
-{$ifdef watcom}
-  {$define has_signal}
-  dpmiexcp,
-{$endif}
-  verbose;
-
-{$ifdef has_signal}
-Var
-  NewSignal,
-  OldSigInt : SignalHandler;
-{$endif}
-
-Const in_const_evaluation : boolean = false;
-
-Implementation
-
-{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
-uses
-  comphook;
-{$ENDIF MACOS_USE_FAKE_SYSUTILS}
-
-{$ifdef has_signal}
-{$ifdef unix}
-Procedure CatchSignal(Sig : Longint);cdecl;
-{$else}
-Function CatchSignal(Sig : longint):longint;
-{$endif}
-begin
-  case Sig of
-    SIGINT :
-      raise EControlCAbort.Create;
-  end;
-{$ifndef unix}
-  CatchSignal:=0;
-{$endif}
-end;
-{$endif def has_signal}
-
-begin
-{$ifndef nocatch}
-  {$ifdef has_signal}
-    NewSignal:=SignalHandler(@CatchSignal);
-    OldSigInt:={$ifdef havelinuxrtl10}Signal{$else}{$ifdef Unix}fpSignal{$else}Signal{$endif}{$endif}  (SIGINT,NewSignal);
-  {$endif}
-{$endif nocatch}
-end.

compiler/compiler/cclasses.pas

@@ -1,2352 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
-
-    This module provides some basic classes
-
-    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 cclasses;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      cutils,cstreams;
-
-{********************************************
-                TMemDebug
-********************************************}
-
-    type
-       tmemdebug = class
-       private
-          totalmem,
-          startmem : integer;
-          infostr  : string[40];
-       public
-          constructor Create(const s:string);
-          destructor  Destroy;override;
-          procedure show;
-          procedure start;
-          procedure stop;
-       end;
-
-{*******************************************************
-   TList (Copied from FCL, exception handling stripped)
-********************************************************}
-
-const
-   MaxListSize = Maxint div 16;
-   SListIndexError = 'List index exceeds bounds (%d)';
-   SListCapacityError = 'The maximum list capacity is reached (%d)';
-   SListCountError = 'List count too large (%d)';
-type
-{ TList class }
-
-   PPointerList = ^TPointerList;
-   TPointerList = array[0..MaxListSize - 1] of Pointer;
-   TListSortCompare = function (Item1, Item2: Pointer): Integer;
-
-   TList = class(TObject)
-   private
-     FList: PPointerList;
-     FCount: Integer;
-     FCapacity: Integer;
-   protected
-     function Get(Index: Integer): Pointer;
-     procedure Grow; virtual;
-     procedure Put(Index: Integer; Item: Pointer);
-     procedure SetCapacity(NewCapacity: Integer);
-     procedure SetCount(NewCount: Integer);
-   public
-     destructor Destroy; override;
-     function Add(Item: Pointer): Integer;
-     procedure Clear; dynamic;
-     procedure Delete(Index: Integer);
-     class procedure Error(const Msg: string; Data: Integer); virtual;
-     procedure Exchange(Index1, Index2: Integer);
-     function Expand: TList;
-     function Extract(item: Pointer): Pointer;
-     function First: Pointer;
-     procedure Assign(Obj:TList);
-     function IndexOf(Item: Pointer): Integer;
-     procedure Insert(Index: Integer; Item: Pointer);
-     function Last: Pointer;
-     procedure Move(CurIndex, NewIndex: Integer);
-     function Remove(Item: Pointer): Integer;
-     procedure Pack;
-     procedure Sort(Compare: TListSortCompare);
-     property Capacity: Integer read FCapacity write SetCapacity;
-     property Count: Integer read FCount write SetCount;
-     property Items[Index: Integer]: Pointer read Get write Put; default;
-     property List: PPointerList read FList;
-   end;
-
-{********************************************
-                TLinkedList
-********************************************}
-
-    type
-       TLinkedListItem = class
-       public
-          Previous,
-          Next : TLinkedListItem;
-          Constructor Create;
-          Destructor Destroy;override;
-          Function GetCopy:TLinkedListItem;virtual;
-       end;
-
-       TLinkedListItemClass = class of TLinkedListItem;
-
-       TLinkedList = class
-       private
-          FCount : integer;
-          FFirst,
-          FLast  : TLinkedListItem;
-          FNoClear : boolean;
-       public
-          constructor Create;
-          destructor  Destroy;override;
-          { true when the List is empty }
-          function  Empty:boolean;
-          { deletes all Items }
-          procedure Clear;
-          { inserts an Item }
-          procedure Insert(Item:TLinkedListItem);
-          { inserts an Item before Loc }
-          procedure InsertBefore(Item,Loc : TLinkedListItem);
-          { inserts an Item after Loc }
-          procedure InsertAfter(Item,Loc : TLinkedListItem);virtual;
-          { concats an Item }
-          procedure Concat(Item:TLinkedListItem);
-          { deletes an Item }
-          procedure Remove(Item:TLinkedListItem);
-          { Gets First Item }
-          function  GetFirst:TLinkedListItem;
-          { Gets last Item }
-          function  GetLast:TLinkedListItem;
-          { inserts another List at the begin and make this List empty }
-          procedure insertList(p : TLinkedList);
-          { inserts another List before the provided item and make this List empty }
-          procedure insertListBefore(Item:TLinkedListItem;p : TLinkedList);
-          { inserts another List after the provided item and make this List empty }
-          procedure insertListAfter(Item:TLinkedListItem;p : TLinkedList);
-          { concats another List at the end and make this List empty }
-          procedure concatList(p : TLinkedList);
-          { concats another List at the start and makes a copy
-            the list is ordered in reverse.
-          }
-          procedure insertListcopy(p : TLinkedList);
-          { concats another List at the end and makes a copy }
-          procedure concatListcopy(p : TLinkedList);
-          property First:TLinkedListItem read FFirst;
-          property Last:TLinkedListItem read FLast;
-          property Count:Integer read FCount;
-          property NoClear:boolean write FNoClear;
-       end;
-
-{********************************************
-                TStringList
-********************************************}
-
-       { string containerItem }
-       TStringListItem = class(TLinkedListItem)
-          FPStr : PString;
-       public
-          constructor Create(const s:string);
-          destructor  Destroy;override;
-          function GetCopy:TLinkedListItem;override;
-          function Str:string;
-       end;
-
-       { string container }
-       TStringList = class(TLinkedList)
-       private
-          FDoubles : boolean;  { if this is set to true, doubles are allowed }
-       public
-          constructor Create;
-          constructor Create_No_Double;
-          { inserts an Item }
-          procedure Insert(const s:string);
-          { concats an Item }
-          procedure Concat(const s:string);
-          { deletes an Item }
-          procedure Remove(const s:string);
-          { Gets First Item }
-          function  GetFirst:string;
-          { Gets last Item }
-          function  GetLast:string;
-          { true if string is in the container, compare case sensitive }
-          function FindCase(const s:string):TStringListItem;
-          { true if string is in the container }
-          function Find(const s:string):TStringListItem;
-          { inserts an item }
-          procedure InsertItem(item:TStringListItem);
-          { concats an item }
-          procedure ConcatItem(item:TStringListItem);
-          property Doubles:boolean read FDoubles write FDoubles;
-       end;
-
-
-{********************************************
-                Dictionary
-********************************************}
-
-    const
-       { the real size will be [0..hasharray-1] ! }
-       hasharraysize = 512;
-
-    type
-       { namedindexobect for use with dictionary and indexarray }
-       TNamedIndexItem=class
-       private
-       { indexarray }
-         FIndexNr    : integer;
-         FIndexNext  : TNamedIndexItem;
-       { dictionary }
-         FLeft,
-         FRight      : TNamedIndexItem;
-         FSpeedValue : cardinal;
-       { singleList }
-         FListNext   : TNamedIndexItem;
-         FName       : Pstring;
-       protected
-         function  GetName:string;virtual;
-         procedure SetName(const n:string);virtual;
-       public
-         constructor Create;
-         constructor CreateName(const n:string);
-         destructor  Destroy;override;
-         property IndexNr:integer read FIndexNr write FIndexNr;
-         property IndexNext:TNamedIndexItem read FIndexNext write FIndexNext;
-         property Name:string read GetName write SetName;
-         property SpeedValue:cardinal read FSpeedValue;
-         property ListNext:TNamedIndexItem read FListNext;
-         property Left:TNamedIndexItem read FLeft write FLeft;
-         property Right:TNamedIndexItem read FRight write FRight;
-       end;
-
-       Pdictionaryhasharray=^Tdictionaryhasharray;
-       Tdictionaryhasharray=array[0..hasharraysize-1] of TNamedIndexItem;
-
-       TnamedIndexCallback = procedure(p:TNamedIndexItem;arg:pointer) of object;
-       TnamedIndexStaticCallback = procedure(p:TNamedIndexItem;arg:pointer);
-
-       Tdictionary=class
-       private
-         FRoot      : TNamedIndexItem;
-         FCount     : longint;
-         FHashArray : Pdictionaryhasharray;
-         procedure cleartree(var obj:TNamedIndexItem);
-         function  insertNode(NewNode:TNamedIndexItem;var currNode:TNamedIndexItem):TNamedIndexItem;
-         procedure inserttree(currtree,currroot:TNamedIndexItem);
-       public
-         noclear   : boolean;
-         delete_doubles : boolean;
-         constructor Create;
-         destructor  Destroy;override;
-         procedure usehash;
-         procedure clear;
-         function  delete(const s:string):TNamedIndexItem;
-         function  empty:boolean;
-         procedure foreach(proc2call:TNamedIndexcallback;arg:pointer);
-         procedure foreach_static(proc2call:TNamedIndexStaticCallback;arg:pointer);
-         function  insert(obj:TNamedIndexItem):TNamedIndexItem;
-         function  replace(oldobj,newobj:TNamedIndexItem):boolean;
-         function  rename(const olds,News : string):TNamedIndexItem;
-         function  search(const s:string):TNamedIndexItem;
-         function  speedsearch(const s:string;SpeedValue:cardinal):TNamedIndexItem;
-         property  Items[const s:string]:TNamedIndexItem read Search;default;
-         property  Count:longint read FCount;
-       end;
-
-       tsingleList=class
-         First,
-         last    : TNamedIndexItem;
-         constructor Create;
-         procedure reset;
-         procedure clear;
-         procedure insert(p:TNamedIndexItem);
-       end;
-
-      tindexobjectarray=array[1..16000] of TNamedIndexItem;
-      pnamedindexobjectarray=^tindexobjectarray;
-
-      tindexarray=class
-        noclear : boolean;
-        First   : TNamedIndexItem;
-        count   : integer;
-        constructor Create(Agrowsize:integer);
-        destructor  destroy;override;
-        procedure clear;
-        procedure foreach(proc2call : Tnamedindexcallback;arg:pointer);
-        procedure foreach_static(proc2call : Tnamedindexstaticcallback;arg:pointer);
-        procedure deleteindex(p:TNamedIndexItem);
-        procedure delete(var p:TNamedIndexItem);
-        procedure insert(p:TNamedIndexItem);
-        procedure replace(oldp,newp:TNamedIndexItem);
-        function  search(nr:integer):TNamedIndexItem;
-      private
-        growsize,
-        size  : integer;
-        data  : pnamedindexobjectarray;
-        procedure grow(gsize:integer);
-      end;
-
-
-{********************************************
-              DynamicArray
-********************************************}
-
-     const
-       dynamicblockbasesize = 12;
-
-     type
-       pdynamicblock = ^tdynamicblock;
-       tdynamicblock = record
-         pos,
-         used : integer;
-         Next : pdynamicblock;
-         { can't use sizeof(integer) because it crashes gdb }
-         data : array[0..1024*1024] of byte;
-       end;
-
-       tdynamicarray = class
-       private
-         FPosn       : integer;
-         FPosnblock  : pdynamicblock;
-         FBlocksize  : integer;
-         FFirstblock,
-         FLastblock  : pdynamicblock;
-         procedure grow;
-       public
-         constructor Create(Ablocksize:integer);
-         destructor  Destroy;override;
-         procedure reset;
-         function  size:integer;
-         procedure align(i:integer);
-         procedure seek(i:integer);
-         function  read(var d;len:integer):integer;
-         procedure write(const d;len:integer);
-         procedure writestr(const s:string);
-         procedure readstream(f:TCStream;maxlen:longint);
-         procedure writestream(f:TCStream);
-         property  BlockSize : integer read FBlocksize;
-         property  FirstBlock : PDynamicBlock read FFirstBlock;
-         property  Pos : integer read FPosn;
-       end;
-
-
-implementation
-
-{*****************************************************************************
-                                    Memory debug
-*****************************************************************************}
-
-    constructor tmemdebug.create(const s:string);
-      begin
-        infostr:=s;
-        totalmem:=0;
-        Start;
-      end;
-
-
-    procedure tmemdebug.start;
-
-      var
-        status : TFPCHeapStatus;
-
-      begin
-        status:=GetFPCHeapStatus;
-        startmem:=status.CurrHeapUsed;
-      end;
-
-
-    procedure tmemdebug.stop;
-      var
-        status : TFPCHeapStatus;
-      begin
-        if startmem<>0 then
-         begin
-           status:=GetFPCHeapStatus;
-           inc(TotalMem,startmem-status.CurrHeapUsed);
-           startmem:=0;
-         end;
-      end;
-
-
-    destructor tmemdebug.destroy;
-      begin
-        Stop;
-        show;
-      end;
-
-
-    procedure tmemdebug.show;
-      begin
-        write('memory [',infostr,'] ');
-        if TotalMem>0 then
-         writeln(DStr(TotalMem shr 10),' Kb released')
-        else
-         writeln(DStr((-TotalMem) shr 10),' Kb allocated');
-      end;
-
-
-{*****************************************************************************
-                                 TList
-*****************************************************************************}
-
-Const
-   // Ratio of Pointer and Word Size.
-   WordRatio = SizeOf(Pointer) Div SizeOf(Word);
-
-function TList.Get(Index: Integer): Pointer;
-
-begin
-   If (Index<0) or (Index>=FCount) then
-     Error(SListIndexError,Index);
-   Result:=FList^[Index];
-end;
-
-
-
-procedure TList.Grow;
-
-begin
-   // Only for compatibility with Delphi. Not needed.
-end;
-
-
-
-procedure TList.Put(Index: Integer; Item: Pointer);
-
-begin
-   if (Index<0) or (Index>=FCount) then
-     Error(SListIndexError,Index);
-   Flist^[Index]:=Item;
-end;
-
-
-function TList.Extract(item: Pointer): Pointer;
-var
-   i : Integer;
-begin
-   result:=nil;
-   i:=IndexOf(item);
-   if i>=0 then
-    begin
-      Result:=item;
-      FList^[i]:=nil;
-      Delete(i);
-    end;
-end;
-
-
-procedure TList.SetCapacity(NewCapacity: Integer);
-begin
-   If (NewCapacity<0) or (NewCapacity>MaxListSize) then
-      Error (SListCapacityError,NewCapacity);
-   if NewCapacity=FCapacity then
-     exit;
-   ReallocMem(FList,SizeOf(Pointer)*NewCapacity);
-   if NewCapacity > FCapacity then
-     FillChar (FList^ [FCapacity],
-                              (NewCapacity - FCapacity) * SizeOf (pointer), 0);
-   FCapacity:=NewCapacity;
-end;
-
-
-
-procedure TList.SetCount(NewCount: Integer);
-
-begin
-   If (NewCount<0) or (NewCount>MaxListSize)then
-     Error(SListCountError,NewCount);
-   If NewCount<FCount then
-     FCount:=NewCount
-   else If NewCount>FCount then
-     begin
-     If NewCount>FCapacity then
-       SetCapacity (NewCount);
-     If FCount<NewCount then
-       FillWord (Flist^[FCount],(NewCount-FCount)* WordRatio ,0);
-     FCount:=Newcount;
-     end;
-end;
-
-
-
-destructor TList.Destroy;
-
-begin
-   Self.Clear;
-   inherited Destroy;
-end;
-
-
-Function TList.Add(Item: Pointer): Integer;
-
-begin
-   Self.Insert (Count,Item);
-   Result:=Count-1;
-end;
-
-
-
-Procedure TList.Clear;
-
-begin
-   If Assigned(FList) then
-     begin
-     FreeMem (Flist,FCapacity*SizeOf(Pointer));
-     FList:=Nil;
-     FCapacity:=0;
-     FCount:=0;
-     end;
-end;
-
-
-Procedure TList.Delete(Index: Integer);
-begin
-   If (Index<0) or (Index>=FCount) then
-     Error (SListIndexError,Index);
-   FCount:=FCount-1;
-   System.Move (FList^[Index+1],FList^[Index],(FCount-Index)*SizeOf(Pointer));
-   // Shrink the list if appropiate
-   if (FCapacity > 256) and (FCount < FCapacity shr 2) then
-   begin
-     FCapacity := FCapacity shr 1;
-     ReallocMem(FList, SizeOf(Pointer) * FCapacity);
-   end;
-end;
-
-
-class procedure TList.Error(const Msg: string; Data: Integer);
-{$ifdef EXTDEBUG}
-var
-  s : string;
-{$endif EXTDEBUG}
-begin
-{$ifdef EXTDEBUG}
-  s:=Msg;
-  Replace(s,'%d',ToStr(Data));
-  writeln(s);
-{$endif EXTDEBUG}
-  internalerrorproc(200411151);
-end;
-
-procedure TList.Exchange(Index1, Index2: Integer);
-
-var Temp : Pointer;
-
-begin
-   If ((Index1>=FCount) or (Index1<0)) then
-     Error(SListIndexError,Index1);
-   If ((Index2>=FCount) or (Index2<0)) then
-     Error(SListIndexError,Index2);
-   Temp:=FList^[Index1];
-   FList^[Index1]:=FList^[Index2];
-   FList^[Index2]:=Temp;
-end;
-
-
-
-function TList.Expand: TList;
-
-Var IncSize : Longint;
-
-begin
-   if FCount<FCapacity then exit;
-   IncSize:=4;
-   if FCapacity>3 then IncSize:=IncSize+4;
-   if FCapacity>8 then IncSize:=IncSize+8;
-   if FCapacity>127 then Inc(IncSize, FCapacity shr 2);
-   SetCapacity(FCapacity+IncSize);
-   Result:=Self;
-end;
-
-
-function TList.First: Pointer;
-
-begin
-   If FCount=0 then
-     Result:=Nil
-   else
-     Result:=Items[0];
-end;
-
-
-
-function TList.IndexOf(Item: Pointer): Integer;
-
-begin
-   Result:=0;
-   While (Result<FCount) and (Flist^[Result]<>Item) do Result:=Result+1;
-   If Result=FCount  then Result:=-1;
-end;
-
-
-
-procedure TList.Insert(Index: Integer; Item: Pointer);
-
-begin
-   If (Index<0) or (Index>FCount )then
-     Error(SlistIndexError,Index);
-   IF FCount=FCapacity Then Self.Expand;
-   If Index<FCount then
-     System.Move(Flist^[Index],Flist^[Index+1],(FCount-Index)*SizeOf(Pointer));
-   FList^[Index]:=Item;
-   FCount:=FCount+1;
-end;
-
-
-
-function TList.Last: Pointer;
-
-begin
-   // Wouldn't it be better to return nil if the count is zero ?
-   If FCount=0 then
-     Result:=Nil
-   else
-     Result:=Items[FCount-1];
-end;
-
-
-procedure TList.Move(CurIndex, NewIndex: Integer);
-
-Var Temp : Pointer;
-
-begin
-   If ((CurIndex<0) or (CurIndex>Count-1)) then
-     Error(SListIndexError,CurIndex);
-   If (NewINdex<0) then
-     Error(SlistIndexError,NewIndex);
-   Temp:=FList^[CurIndex];
-   FList^[CurIndex]:=Nil;
-   Self.Delete(CurIndex);
-   // ?? If NewIndex>CurIndex then NewIndex:=NewIndex-1;
-   // Newindex changes when deleting ??
-   Self.Insert (NewIndex,Nil);
-   FList^[NewIndex]:=Temp;
-end;
-
-
-function TList.Remove(Item: Pointer): Integer;
-
-begin
-   Result:=IndexOf(Item);
-   If Result<>-1 then
-     Self.Delete (Result);
-end;
-
-
-
-Procedure TList.Pack;
-
-Var  {Last,I,J,}Runner : Longint;
-
-begin
-   // Not the fastest; but surely correct
-   For Runner:=Fcount-1 downto 0 do
-     if Items[Runner]=Nil then Self.Delete(Runner);
-{ The following may be faster in case of large and defragmented lists
-   If count=0 then exit;
-   Runner:=0;I:=0;
-   TheLast:=Count;
-   while runner<count do
-     begin
-     // Find first Nil
-     While (FList^[Runner]<>Nil) and (Runner<Count) do Runner:=Runner+1;
-     if Runner<Count do
-       begin
-       // Start searching for non-nil from last known nil+1
-       if i<Runner then I:=Runner+1;
-       While (Flist[I]^=Nil) and (I<Count) do I:=I+1;
-       // Start looking for last non-nil of block.
-       J:=I+1;
-       While (Flist^[J]<>Nil) and (J<Count) do J:=J+1;
-       // Move block and zero out
-       Move (Flist^[I],Flist^[Runner],J*SizeOf(Pointer));
-       FillWord (Flist^[I],(J-I)*WordRatio,0);
-       // Update Runner and Last to point behind last block
-       TheLast:=Runner+(J-I);
-       If J=Count then
-          begin
-          // Shortcut, when J=Count we checked all pointers
-          Runner:=Count
-       else
-          begin
-          Runner:=TheLast;
-          I:=j;
-       end;
-     end;
-   Count:=TheLast;
-}
-end;
-
-// Needed by Sort method.
-
-Procedure QuickSort (Flist : PPointerList; L,R : Longint;
-                      Compare : TListSortCompare);
-
-Var I,J : Longint;
-     P,Q : Pointer;
-
-begin
-  Repeat
-    I:=L;
-    J:=R;
-    P:=FList^[ (L+R) div 2 ];
-    repeat
-      While Compare(P,FList^[i])>0 Do I:=I+1;
-      While Compare(P,FList^[J])<0 Do J:=J-1;
-      If I<=J then
-        begin
-        Q:=Flist^[I];
-        Flist^[I]:=FList^[J];
-        FList^[J]:=Q;
-        I:=I+1;
-        J:=j-1;
-        end;
-    Until I>J;
-    If L<J then QuickSort (FList,L,J,Compare);
-    L:=I;
-  Until I>=R;
-end;
-
-procedure TList.Sort(Compare: TListSortCompare);
-
-begin
-   If Not Assigned(FList) or (FCount<2) then exit;
-   QuickSort (Flist, 0, FCount-1,Compare);
-end;
-
-procedure TList.Assign(Obj:TList);
-// Principle copied from TCollection
-
-var i : Integer;
-begin
-   Clear;
-   For I:=0 To Obj.Count-1 Do
-     Add(Obj[i]);
-end;
-
-
-{****************************************************************************
-                             TLinkedListItem
- ****************************************************************************}
-
-    constructor TLinkedListItem.Create;
-      begin
-        Previous:=nil;
-        Next:=nil;
-      end;
-
-
-    destructor TLinkedListItem.Destroy;
-      begin
-      end;
-
-
-    function TLinkedListItem.GetCopy:TLinkedListItem;
-      var
-        p : TLinkedListItem;
-        l : integer;
-      begin
-        p:=TLinkedListItemClass(ClassType).Create;
-        l:=InstanceSize;
-        Move(pointer(self)^,pointer(p)^,l);
-        Result:=p;
-      end;
-
-
-{****************************************************************************
-                                   TLinkedList
- ****************************************************************************}
-
-    constructor TLinkedList.Create;
-      begin
-        FFirst:=nil;
-        Flast:=nil;
-        FCount:=0;
-        FNoClear:=False;
-      end;
-
-
-    destructor TLinkedList.destroy;
-      begin
-        if not FNoClear then
-         Clear;
-      end;
-
-
-    function TLinkedList.empty:boolean;
-      begin
-        Empty:=(FFirst=nil);
-      end;
-
-
-    procedure TLinkedList.Insert(Item:TLinkedListItem);
-      begin
-        if FFirst=nil then
-         begin
-           FLast:=Item;
-           Item.Previous:=nil;
-           Item.Next:=nil;
-         end
-        else
-         begin
-           FFirst.Previous:=Item;
-           Item.Previous:=nil;
-           Item.Next:=FFirst;
-         end;
-        FFirst:=Item;
-        inc(FCount);
-      end;
-
-
-    procedure TLinkedList.InsertBefore(Item,Loc : TLinkedListItem);
-      begin
-         Item.Previous:=Loc.Previous;
-         Item.Next:=Loc;
-         Loc.Previous:=Item;
-         if assigned(Item.Previous) then
-           Item.Previous.Next:=Item
-         else
-           { if we've no next item, we've to adjust FFist }
-           FFirst:=Item;
-         inc(FCount);
-      end;
-
-
-    procedure TLinkedList.InsertAfter(Item,Loc : TLinkedListItem);
-      begin
-         Item.Next:=Loc.Next;
-         Loc.Next:=Item;
-         Item.Previous:=Loc;
-         if assigned(Item.Next) then
-           Item.Next.Previous:=Item
-         else
-           { if we've no next item, we've to adjust FLast }
-           FLast:=Item;
-         inc(FCount);
-      end;
-
-
-    procedure TLinkedList.Concat(Item:TLinkedListItem);
-      begin
-        if FFirst=nil then
-         begin
-           FFirst:=Item;
-           Item.Previous:=nil;
-           Item.Next:=nil;
-         end
-        else
-         begin
-           Flast.Next:=Item;
-           Item.Previous:=Flast;
-           Item.Next:=nil;
-         end;
-        Flast:=Item;
-        inc(FCount);
-      end;
-
-
-    procedure TLinkedList.remove(Item:TLinkedListItem);
-      begin
-         if Item=nil then
-           exit;
-         if (FFirst=Item) and (Flast=Item) then
-           begin
-              FFirst:=nil;
-              Flast:=nil;
-           end
-         else if FFirst=Item then
-           begin
-              FFirst:=Item.Next;
-              if assigned(FFirst) then
-                FFirst.Previous:=nil;
-           end
-         else if Flast=Item then
-           begin
-              Flast:=Flast.Previous;
-              if assigned(Flast) then
-                Flast.Next:=nil;
-           end
-         else
-           begin
-              Item.Previous.Next:=Item.Next;
-              Item.Next.Previous:=Item.Previous;
-           end;
-         Item.Next:=nil;
-         Item.Previous:=nil;
-         dec(FCount);
-      end;
-
-
-    procedure TLinkedList.clear;
-      var
-        NewNode : TLinkedListItem;
-      begin
-        NewNode:=FFirst;
-        while assigned(NewNode) do
-         begin
-           FFirst:=NewNode.Next;
-           NewNode.Free;
-           NewNode:=FFirst;
-          end;
-        FLast:=nil;
-        FFirst:=nil;
-        FCount:=0;
-      end;
-
-
-    function TLinkedList.GetFirst:TLinkedListItem;
-      begin
-         if FFirst=nil then
-          GetFirst:=nil
-         else
-          begin
-            GetFirst:=FFirst;
-            if FFirst=FLast then
-             FLast:=nil;
-            FFirst:=FFirst.Next;
-            dec(FCount);
-          end;
-      end;
-
-
-    function TLinkedList.GetLast:TLinkedListItem;
-      begin
-         if FLast=nil then
-          Getlast:=nil
-         else
-          begin
-            Getlast:=FLast;
-            if FLast=FFirst then
-             FFirst:=nil;
-            FLast:=FLast.Previous;
-            dec(FCount);
-          end;
-      end;
-
-
-    procedure TLinkedList.insertList(p : TLinkedList);
-      begin
-         { empty List ? }
-         if (p.FFirst=nil) then
-           exit;
-         p.Flast.Next:=FFirst;
-         { we have a double Linked List }
-         if assigned(FFirst) then
-           FFirst.Previous:=p.Flast;
-         FFirst:=p.FFirst;
-         if (FLast=nil) then
-           Flast:=p.Flast;
-         inc(FCount,p.FCount);
-         { p becomes empty }
-         p.FFirst:=nil;
-         p.Flast:=nil;
-         p.FCount:=0;
-      end;
-
-
-    procedure TLinkedList.insertListBefore(Item:TLinkedListItem;p : TLinkedList);
-      begin
-         { empty List ? }
-         if (p.FFirst=nil) then
-           exit;
-         if (Item=nil) then
-           begin
-             { Insert at begin }
-             InsertList(p);
-             exit;
-           end
-         else
-           begin
-             p.FLast.Next:=Item;
-             p.FFirst.Previous:=Item.Previous;
-             if assigned(Item.Previous) then
-               Item.Previous.Next:=p.FFirst
-             else
-               FFirst:=p.FFirst;
-             Item.Previous:=p.FLast;
-             inc(FCount,p.FCount);
-           end;
-         { p becomes empty }
-         p.FFirst:=nil;
-         p.Flast:=nil;
-         p.FCount:=0;
-      end;
-
-
-    procedure TLinkedList.insertListAfter(Item:TLinkedListItem;p : TLinkedList);
-      begin
-         { empty List ? }
-         if (p.FFirst=nil) then
-           exit;
-         if (Item=nil) then
-           begin
-             { Insert at begin }
-             InsertList(p);
-             exit;
-           end
-         else
-           begin
-             p.FFirst.Previous:=Item;
-             p.FLast.Next:=Item.Next;
-             if assigned(Item.Next) then
-               Item.Next.Previous:=p.FLast
-             else
-               FLast:=p.FLast;
-             Item.Next:=p.FFirst;
-             inc(FCount,p.FCount);
-           end;
-         { p becomes empty }
-         p.FFirst:=nil;
-         p.Flast:=nil;
-         p.FCount:=0;
-      end;
-
-
-    procedure TLinkedList.concatList(p : TLinkedList);
-      begin
-        if (p.FFirst=nil) then
-         exit;
-        if FFirst=nil then
-         FFirst:=p.FFirst
-        else
-         begin
-           FLast.Next:=p.FFirst;
-           p.FFirst.Previous:=Flast;
-         end;
-        Flast:=p.Flast;
-        inc(FCount,p.FCount);
-        { make p empty }
-        p.Flast:=nil;
-        p.FFirst:=nil;
-        p.FCount:=0;
-      end;
-
-
-    procedure TLinkedList.insertListcopy(p : TLinkedList);
-      var
-        NewNode,NewNode2 : TLinkedListItem;
-      begin
-        NewNode:=p.First;
-        while assigned(NewNode) do
-         begin
-           NewNode2:=NewNode.Getcopy;
-           if assigned(NewNode2) then
-            Insert(NewNode2);
-           NewNode:=NewNode.Next;
-         end;
-      end;
-
-
-    procedure TLinkedList.concatListcopy(p : TLinkedList);
-      var
-        NewNode,NewNode2 : TLinkedListItem;
-      begin
-        NewNode:=p.First;
-        while assigned(NewNode) do
-         begin
-           NewNode2:=NewNode.Getcopy;
-           if assigned(NewNode2) then
-            Concat(NewNode2);
-           NewNode:=NewNode.Next;
-         end;
-      end;
-
-
-{****************************************************************************
-                             TStringListItem
- ****************************************************************************}
-
-    constructor TStringListItem.Create(const s:string);
-      begin
-        inherited Create;
-        FPStr:=stringdup(s);
-      end;
-
-
-    destructor TStringListItem.Destroy;
-      begin
-        stringdispose(FPStr);
-      end;
-
-
-    function TStringListItem.Str:string;
-      begin
-        Str:=FPStr^;
-      end;
-
-
-    function TStringListItem.GetCopy:TLinkedListItem;
-      begin
-        Result:=(inherited GetCopy);
-        TStringListItem(Result).FPStr:=stringdup(FPstr^);
-      end;
-
-
-{****************************************************************************
-                           TSTRINGList
- ****************************************************************************}
-
-    constructor tstringList.Create;
-      begin
-         inherited Create;
-         FDoubles:=true;
-      end;
-
-
-    constructor tstringList.Create_no_double;
-      begin
-         inherited Create;
-         FDoubles:=false;
-      end;
-
-
-    procedure tstringList.insert(const s : string);
-      begin
-         if (s='') or
-            ((not FDoubles) and (find(s)<>nil)) then
-          exit;
-         inherited insert(tstringListItem.create(s));
-      end;
-
-
-    procedure tstringList.concat(const s : string);
-      begin
-         if (s='') or
-            ((not FDoubles) and (find(s)<>nil)) then
-          exit;
-         inherited concat(tstringListItem.create(s));
-      end;
-
-
-    procedure tstringList.remove(const s : string);
-      var
-        p : tstringListItem;
-      begin
-        if s='' then
-         exit;
-        p:=find(s);
-        if assigned(p) then
-         begin
-           inherited Remove(p);
-           p.Free;
-         end;
-      end;
-
-
-    function tstringList.GetFirst : string;
-      var
-         p : tstringListItem;
-      begin
-         p:=tstringListItem(inherited GetFirst);
-         if p=nil then
-          GetFirst:=''
-         else
-          begin
-            GetFirst:=p.FPStr^;
-            p.free;
-          end;
-      end;
-
-
-    function tstringList.Getlast : string;
-      var
-         p : tstringListItem;
-      begin
-         p:=tstringListItem(inherited Getlast);
-         if p=nil then
-          Getlast:=''
-         else
-          begin
-            Getlast:=p.FPStr^;
-            p.free;
-          end;
-      end;
-
-
-    function tstringList.FindCase(const s:string):TstringListItem;
-      var
-        NewNode : tstringListItem;
-      begin
-        result:=nil;
-        if s='' then
-         exit;
-        NewNode:=tstringListItem(FFirst);
-        while assigned(NewNode) do
-         begin
-           if NewNode.FPStr^=s then
-            begin
-              result:=NewNode;
-              exit;
-            end;
-           NewNode:=tstringListItem(NewNode.Next);
-         end;
-      end;
-
-
-    function tstringList.Find(const s:string):TstringListItem;
-      var
-        NewNode : tstringListItem;
-        ups     : string;
-      begin
-        result:=nil;
-        if s='' then
-         exit;
-        ups:=upper(s);
-        NewNode:=tstringListItem(FFirst);
-        while assigned(NewNode) do
-         begin
-           if upper(NewNode.FPStr^)=ups then
-            begin
-              result:=NewNode;
-              exit;
-            end;
-           NewNode:=tstringListItem(NewNode.Next);
-         end;
-      end;
-
-
-    procedure TStringList.InsertItem(item:TStringListItem);
-      begin
-        inherited Insert(item);
-      end;
-
-
-    procedure TStringList.ConcatItem(item:TStringListItem);
-      begin
-        inherited Concat(item);
-      end;
-
-
-{****************************************************************************
-                               TNamedIndexItem
- ****************************************************************************}
-
-    constructor TNamedIndexItem.Create;
-      begin
-        { index }
-        Findexnr:=-1;
-        FindexNext:=nil;
-        { dictionary }
-        Fleft:=nil;
-        Fright:=nil;
-        FName:=nil;
-        Fspeedvalue:=cardinal($ffffffff);
-        { List }
-        FListNext:=nil;
-      end;
-
-    constructor TNamedIndexItem.Createname(const n:string);
-      begin
-        { index }
-        Findexnr:=-1;
-        FindexNext:=nil;
-        { dictionary }
-        Fleft:=nil;
-        Fright:=nil;
-        fspeedvalue:=getspeedvalue(n);
-      {$ifdef compress}
-        FName:=stringdup(minilzw_encode(n));
-      {$else}
-        FName:=stringdup(n);
-      {$endif}
-        { List }
-        FListNext:=nil;
-      end;
-
-
-    destructor TNamedIndexItem.destroy;
-      begin
-        stringdispose(FName);
-      end;
-
-
-    procedure TNamedIndexItem.setname(const n:string);
-      begin
-        if assigned(FName) then
-          stringdispose(FName);
-        fspeedvalue:=getspeedvalue(n);
-      {$ifdef compress}
-        FName:=stringdup(minilzw_encode(n));
-      {$else}
-        FName:=stringdup(n);
-      {$endif}
-      end;
-
-
-    function TNamedIndexItem.GetName:string;
-      begin
-        if assigned(FName) then
-        {$ifdef compress}
-         Getname:=minilzw_decode(FName^)
-        {$else}
-         Getname:=FName^
-        {$endif}
-        else
-         Getname:='';
-      end;
-
-
-{****************************************************************************
-                               TDICTIONARY
-****************************************************************************}
-
-    constructor Tdictionary.Create;
-      begin
-        FRoot:=nil;
-        FHashArray:=nil;
-        noclear:=false;
-        delete_doubles:=false;
-      end;
-
-
-    procedure Tdictionary.usehash;
-      begin
-        if not(assigned(FRoot)) and
-           not(assigned(FHashArray)) then
-         begin
-           New(FHashArray);
-           fillchar(FHashArray^,sizeof(FHashArray^),0);
-         end;
-      end;
-
-
-    function counttree(p: tnamedindexitem): longint;
-      begin
-        counttree:=0;
-        if not assigned(p) then
-          exit;
-        result := 1;
-        inc(result,counttree(p.fleft));
-        inc(result,counttree(p.fright));
-      end;
-
-    destructor Tdictionary.destroy;
-      begin
-        if not noclear then
-         clear;
-        if assigned(FHashArray) then
-         begin
-           dispose(FHashArray);
-         end;
-      end;
-
-
-    procedure Tdictionary.cleartree(var obj:TNamedIndexItem);
-      begin
-        if assigned(obj.Fleft) then
-          cleartree(obj.FLeft);
-        if assigned(obj.FRight) then
-          cleartree(obj.FRight);
-        obj.free;
-        obj:=nil;
-      end;
-
-
-    procedure Tdictionary.clear;
-      var
-        w : integer;
-      begin
-        if assigned(FRoot) then
-          cleartree(FRoot);
-        if assigned(FHashArray) then
-         for w:= low(FHashArray^) to high(FHashArray^) do
-          if assigned(FHashArray^[w]) then
-           cleartree(FHashArray^[w]);
-      end;
-
-
-    function Tdictionary.delete(const s:string):TNamedIndexItem;
-      var
-        p,SpeedValue : cardinal;
-        n : TNamedIndexItem;
-      {$ifdef compress}
-        senc:string;
-      {$else}
-        senc:string absolute s;
-      {$endif}
-
-        procedure insert_right_bottom(var root,Atree:TNamedIndexItem);
-          begin
-            while root.FRight<>nil do
-             root:=root.FRight;
-            root.FRight:=Atree;
-          end;
-
-        function delete_from_tree(root:TNamedIndexItem):TNamedIndexItem;
-          type
-            leftright=(left,right);
-          var
-            lr : leftright;
-            oldroot : TNamedIndexItem;
-          begin
-            oldroot:=nil;
-            while (root<>nil) and (root.SpeedValue<>SpeedValue) do
-             begin
-               oldroot:=root;
-               if SpeedValue<root.SpeedValue then
-                begin
-                  root:=root.FRight;
-                  lr:=right;
-                end
-               else
-                begin
-                  root:=root.FLeft;
-                  lr:=left;
-                end;
-             end;
-            while (root<>nil) and (root.FName^<>senc) do
-             begin
-               oldroot:=root;
-               if senc<root.FName^ then
-                begin
-                  root:=root.FRight;
-                  lr:=right;
-                end
-               else
-                begin
-                  root:=root.FLeft;
-                  lr:=left;
-                end;
-             end;
-            if root<>nil then
-              begin
-                dec(FCount);
-                if root.FLeft<>nil then
-                 begin
-                   { Now the Node pointing to root must point to the left
-                     subtree of root. The right subtree of root must be
-                     connected to the right bottom of the left subtree.}
-                   if lr=left then
-                    oldroot.FLeft:=root.FLeft
-                   else
-                    oldroot.FRight:=root.FLeft;
-                   if root.FRight<>nil then
-                    insert_right_bottom(root.FLeft,root.FRight);
-                 end
-                else
-                 begin
-                   { There is no left subtree. So we can just replace the Node to
-                     delete with the right subtree.}
-                   if lr=left then
-                    oldroot.FLeft:=root.FRight
-                   else
-                    oldroot.FRight:=root.FRight;
-                 end;
-              end;
-            delete_from_tree:=root;
-          end;
-
-      begin
-      {$ifdef compress}
-        senc:=minilzw_encode(s);
-      {$endif}
-        SpeedValue:=GetSpeedValue(s);
-        n:=FRoot;
-        if assigned(FHashArray) then
-         begin
-           { First, check if the Node to delete directly located under
-             the hasharray.}
-           p:=SpeedValue mod hasharraysize;
-           n:=FHashArray^[p];
-           if (n<>nil) and (n.SpeedValue=SpeedValue) and
-              (n.FName^=senc) then
-            begin
-              { The Node to delete is directly located under the
-                hasharray. Make the hasharray point to the left
-                subtree of the Node and place the right subtree on
-                the right-bottom of the left subtree.}
-              if n.FLeft<>nil then
-               begin
-                 FHashArray^[p]:=n.FLeft;
-                 if n.FRight<>nil then
-                  insert_right_bottom(n.FLeft,n.FRight);
-               end
-              else
-               FHashArray^[p]:=n.FRight;
-              delete:=n;
-              dec(FCount);
-              exit;
-            end;
-         end
-        else
-         begin
-           { First check if the Node to delete is the root.}
-           if (FRoot<>nil) and (n.SpeedValue=SpeedValue) and
-              (n.FName^=senc) then
-            begin
-              if n.FLeft<>nil then
-               begin
-                 FRoot:=n.FLeft;
-                 if n.FRight<>nil then
-                  insert_right_bottom(n.FLeft,n.FRight);
-               end
-              else
-               FRoot:=n.FRight;
-              delete:=n;
-              dec(FCount);
-              exit;
-            end;
-         end;
-        delete:=delete_from_tree(n);
-      end;
-
-    function Tdictionary.empty:boolean;
-      var
-        w : integer;
-      begin
-        if assigned(FHashArray) then
-         begin
-           empty:=false;
-           for w:=low(FHashArray^) to high(FHashArray^) do
-            if assigned(FHashArray^[w]) then
-             exit;
-           empty:=true;
-         end
-        else
-         empty:=(FRoot=nil);
-      end;
-
-
-    procedure Tdictionary.foreach(proc2call:TNamedIndexcallback;arg:pointer);
-
-        procedure a(p:TNamedIndexItem;arg:pointer);
-        begin
-          proc2call(p,arg);
-          if assigned(p.FLeft) then
-           a(p.FLeft,arg);
-          if assigned(p.FRight) then
-           a(p.FRight,arg);
-        end;
-
-      var
-        i : integer;
-      begin
-        if assigned(FHashArray) then
-         begin
-           for i:=low(FHashArray^) to high(FHashArray^) do
-            if assigned(FHashArray^[i]) then
-             a(FHashArray^[i],arg);
-         end
-        else
-         if assigned(FRoot) then
-          a(FRoot,arg);
-      end;
-
-
-    procedure Tdictionary.foreach_static(proc2call:TNamedIndexStaticCallback;arg:pointer);
-
-        procedure a(p:TNamedIndexItem;arg:pointer);
-        begin
-          proc2call(p,arg);
-          if assigned(p.FLeft) then
-           a(p.FLeft,arg);
-          if assigned(p.FRight) then
-           a(p.FRight,arg);
-        end;
-
-      var
-        i : integer;
-      begin
-        if assigned(FHashArray) then
-         begin
-           for i:=low(FHashArray^) to high(FHashArray^) do
-            if assigned(FHashArray^[i]) then
-             a(FHashArray^[i],arg);
-         end
-        else
-         if assigned(FRoot) then
-          a(FRoot,arg);
-      end;
-
-
-    function Tdictionary.replace(oldobj,newobj:TNamedIndexItem):boolean;
-      var
-        hp : TNamedIndexItem;
-      begin
-        hp:=nil;
-        Replace:=false;
-        { must be the same name and hash }
-        if (oldobj.FSpeedValue<>newobj.FSpeedValue) or
-           (oldobj.FName^<>newobj.FName^) then
-         exit;
-        { copy tree info }
-        newobj.FLeft:=oldobj.FLeft;
-        newobj.FRight:=oldobj.FRight;
-        { update treeroot }
-        if assigned(FHashArray) then
-         begin
-           hp:=FHashArray^[newobj.FSpeedValue mod hasharraysize];
-           if hp=oldobj then
-            begin
-              FHashArray^[newobj.FSpeedValue mod hasharraysize]:=newobj;
-              hp:=nil;
-            end;
-         end
-        else
-         begin
-           hp:=FRoot;
-           if hp=oldobj then
-            begin
-              FRoot:=newobj;
-              hp:=nil;
-            end;
-         end;
-        { update parent entry }
-        while assigned(hp) do
-         begin
-           { is the node to replace the left or right, then
-             update this node and stop }
-           if hp.FLeft=oldobj then
-            begin
-              hp.FLeft:=newobj;
-              break;
-            end;
-           if hp.FRight=oldobj then
-            begin
-              hp.FRight:=newobj;
-              break;
-            end;
-           { First check SpeedValue, to allow a fast insert }
-           if hp.SpeedValue>oldobj.SpeedValue then
-            hp:=hp.FRight
-           else
-            if hp.SpeedValue<oldobj.SpeedValue then
-             hp:=hp.FLeft
-           else
-            begin
-              if (hp.FName^=oldobj.FName^) then
-               begin
-                 { this can never happend, return error }
-                 exit;
-               end
-              else
-               if oldobj.FName^>hp.FName^ then
-                hp:=hp.FLeft
-              else
-               hp:=hp.FRight;
-            end;
-         end;
-        Replace:=true;
-      end;
-
-
-    function Tdictionary.insert(obj:TNamedIndexItem):TNamedIndexItem;
-      begin
-        inc(FCount);
-        if assigned(FHashArray) then
-          insert:=insertNode(obj,FHashArray^[obj.SpeedValue mod hasharraysize])
-        else
-          insert:=insertNode(obj,FRoot);
-      end;
-
-
-    function tdictionary.insertNode(NewNode:TNamedIndexItem;var currNode:TNamedIndexItem):TNamedIndexItem;
-      begin
-        if currNode=nil then
-         begin
-           currNode:=NewNode;
-           insertNode:=NewNode;
-         end
-        { First check SpeedValue, to allow a fast insert }
-        else
-         if currNode.SpeedValue>NewNode.SpeedValue then
-          insertNode:=insertNode(NewNode,currNode.FRight)
-        else
-         if currNode.SpeedValue<NewNode.SpeedValue then
-          insertNode:=insertNode(NewNode,currNode.FLeft)
-        else
-         begin
-           if currNode.FName^>NewNode.FName^ then
-            insertNode:=insertNode(NewNode,currNode.FRight)
-           else
-            if currNode.FName^<NewNode.FName^ then
-             insertNode:=insertNode(NewNode,currNode.FLeft)
-           else
-            begin
-              if (delete_doubles) and
-                 assigned(currNode) then
-                begin
-                  NewNode.FLeft:=currNode.FLeft;
-                  NewNode.FRight:=currNode.FRight;
-                  if delete_doubles then
-                    begin
-                      currnode.FLeft:=nil;
-                      currnode.FRight:=nil;
-                      currnode.free;
-                    end;
-                  currNode:=NewNode;
-                  insertNode:=NewNode;
-                end
-              else
-               insertNode:=currNode;
-             end;
-         end;
-      end;
-
-
-    procedure tdictionary.inserttree(currtree,currroot:TNamedIndexItem);
-      begin
-        if assigned(currtree) then
-         begin
-           inserttree(currtree.FLeft,currroot);
-           inserttree(currtree.FRight,currroot);
-           currtree.FRight:=nil;
-           currtree.FLeft:=nil;
-           insertNode(currtree,currroot);
-         end;
-      end;
-
-
-    function tdictionary.rename(const olds,News : string):TNamedIndexItem;
-      var
-        spdval : cardinal;
-        lasthp,
-        hp,hp2,hp3 : TNamedIndexItem;
-      {$ifdef compress}
-        oldsenc,newsenc:string;
-      {$else}
-        oldsenc:string absolute olds;
-        newsenc:string absolute news;
-      {$endif}
-      begin
-      {$ifdef compress}
-        oldsenc:=minilzw_encode(olds);
-        newsenc:=minilzw_encode(news);
-      {$endif}
-        spdval:=GetSpeedValue(olds);
-        if assigned(FHashArray) then
-         hp:=FHashArray^[spdval mod hasharraysize]
-        else
-         hp:=FRoot;
-        lasthp:=nil;
-        while assigned(hp) do
-          begin
-            if spdval>hp.SpeedValue then
-             begin
-               lasthp:=hp;
-               hp:=hp.FLeft
-             end
-            else
-             if spdval<hp.SpeedValue then
-              begin
-                lasthp:=hp;
-                hp:=hp.FRight
-              end
-            else
-             begin
-               if (hp.FName^=oldsenc) then
-                begin
-                  { Get in hp2 the replacer for the root or hasharr }
-                  hp2:=hp.FLeft;
-                  hp3:=hp.FRight;
-                  if not assigned(hp2) then
-                   begin
-                     hp2:=hp.FRight;
-                     hp3:=hp.FLeft;
-                   end;
-                  { remove entry from the tree }
-                  if assigned(lasthp) then
-                   begin
-                     if lasthp.FLeft=hp then
-                      lasthp.FLeft:=hp2
-                     else
-                      lasthp.FRight:=hp2;
-                   end
-                  else
-                   begin
-                     if assigned(FHashArray) then
-                      FHashArray^[spdval mod hasharraysize]:=hp2
-                     else
-                      FRoot:=hp2;
-                   end;
-                  { reinsert the hp3 in the tree from hp2 }
-                  inserttree(hp3,hp2);
-                  { reset Node with New values }
-                  hp.FLeft:=nil;
-                  hp.FRight:=nil;
-                  stringdispose(hp.FName);
-                  hp.FName:=stringdup(newsenc);
-                  hp.FSpeedValue:=GetSpeedValue(news);
-                  { reinsert }
-                  if assigned(FHashArray) then
-                   rename:=insertNode(hp,FHashArray^[hp.SpeedValue mod hasharraysize])
-                  else
-                   rename:=insertNode(hp,FRoot);
-                  exit;
-                end
-               else
-                if oldsenc>hp.FName^ then
-                 begin
-                   lasthp:=hp;
-                   hp:=hp.FLeft
-                 end
-                else
-                 begin
-                   lasthp:=hp;
-                   hp:=hp.FRight;
-                 end;
-             end;
-          end;
-        result := nil;
-      end;
-
-
-    function Tdictionary.search(const s:string):TNamedIndexItem;
-
-    begin
-      search:=speedsearch(s,getspeedvalue(s));
-    end;
-
-
-    function Tdictionary.speedsearch(const s:string;SpeedValue:cardinal):TNamedIndexItem;
-      var
-        NewNode:TNamedIndexItem;
-      {$ifdef compress}
-        decn:string;
-      {$endif}
-      begin
-        if assigned(FHashArray) then
-         NewNode:=FHashArray^[SpeedValue mod hasharraysize]
-        else
-         NewNode:=FRoot;
-        while assigned(NewNode) do
-         begin
-           if SpeedValue>NewNode.SpeedValue then
-            NewNode:=NewNode.FLeft
-           else
-            if SpeedValue<NewNode.SpeedValue then
-             NewNode:=NewNode.FRight
-           else
-            begin
-            {$ifdef compress}
-              decn:=minilzw_decode(newnode.fname^);
-              if (decn=s) then
-               begin
-                 speedsearch:=NewNode;
-                 exit;
-               end
-              else
-               if s>decn then
-                NewNode:=NewNode.FLeft
-              else
-               NewNode:=NewNode.FRight;
-            {$else}
-              if (NewNode.FName^=s) then
-               begin
-                 speedsearch:=NewNode;
-                 exit;
-               end
-              else
-               if s>NewNode.FName^ then
-                NewNode:=NewNode.FLeft
-              else
-               NewNode:=NewNode.FRight;
-            {$endif}
-            end;
-         end;
-        speedsearch:=nil;
-      end;
-
-{****************************************************************************
-                               tsingleList
- ****************************************************************************}
-
-    constructor tsingleList.create;
-      begin
-        First:=nil;
-        last:=nil;
-      end;
-
-
-    procedure tsingleList.reset;
-      begin
-        First:=nil;
-        last:=nil;
-      end;
-
-
-    procedure tsingleList.clear;
-      var
-        hp,hp2 : TNamedIndexItem;
-      begin
-        hp:=First;
-        while assigned(hp) do
-         begin
-           hp2:=hp;
-           hp:=hp.FListNext;
-           hp2.free;
-         end;
-        First:=nil;
-        last:=nil;
-      end;
-
-
-    procedure tsingleList.insert(p:TNamedIndexItem);
-      begin
-        if not assigned(First) then
-         First:=p
-        else
-         last.FListNext:=p;
-        last:=p;
-        p.FListNext:=nil;
-      end;
-
-
-{****************************************************************************
-                               tindexarray
- ****************************************************************************}
-
-    constructor tindexarray.create(Agrowsize:integer);
-      begin
-        growsize:=Agrowsize;
-        size:=0;
-        count:=0;
-        data:=nil;
-        First:=nil;
-        noclear:=false;
-      end;
-
-
-    destructor tindexarray.destroy;
-      begin
-        if assigned(data) then
-          begin
-             if not noclear then
-              clear;
-             freemem(data);
-             data:=nil;
-          end;
-      end;
-
-
-    function tindexarray.search(nr:integer):TNamedIndexItem;
-      begin
-        if nr<=count then
-         search:=data^[nr]
-        else
-         search:=nil;
-      end;
-
-
-    procedure tindexarray.clear;
-      var
-        i : integer;
-      begin
-        for i:=1 to count do
-         if assigned(data^[i]) then
-          begin
-            data^[i].free;
-            data^[i]:=nil;
-          end;
-        count:=0;
-        First:=nil;
-      end;
-
-
-    procedure tindexarray.foreach(proc2call : Tnamedindexcallback;arg:pointer);
-      var
-        i : integer;
-      begin
-        for i:=1 to count do
-         if assigned(data^[i]) then
-          proc2call(data^[i],arg);
-      end;
-
-
-    procedure tindexarray.foreach_static(proc2call : Tnamedindexstaticcallback;arg:pointer);
-      var
-        i : integer;
-      begin
-        for i:=1 to count do
-         if assigned(data^[i]) then
-          proc2call(data^[i],arg);
-      end;
-
-
-    procedure tindexarray.grow(gsize:integer);
-      var
-        osize : integer;
-      begin
-        osize:=size;
-        inc(size,gsize);
-        reallocmem(data,size*sizeof(pointer));
-        fillchar(data^[osize+1],gsize*sizeof(pointer),0);
-      end;
-
-
-    procedure tindexarray.deleteindex(p:TNamedIndexItem);
-      var
-        i : integer;
-      begin
-        i:=p.Findexnr;
-        { update counter }
-        if i=count then
-         dec(count);
-        { update Linked List }
-        while (i>0) do
-         begin
-           dec(i);
-           if (i>0) and assigned(data^[i]) then
-            begin
-              data^[i].FindexNext:=data^[p.Findexnr].FindexNext;
-              break;
-            end;
-         end;
-        if i=0 then
-         First:=p.FindexNext;
-        data^[p.FIndexnr]:=nil;
-        { clear entry }
-        p.FIndexnr:=-1;
-        p.FIndexNext:=nil;
-      end;
-
-
-    procedure tindexarray.delete(var p:TNamedIndexItem);
-      begin
-        deleteindex(p);
-        p.free;
-        p:=nil;
-      end;
-
-
-    procedure tindexarray.insert(p:TNamedIndexItem);
-      var
-        i  : integer;
-      begin
-        if p.FIndexnr=-1 then
-         begin
-           inc(count);
-           p.FIndexnr:=count;
-         end;
-        if p.FIndexnr>count then
-         count:=p.FIndexnr;
-        if count>size then
-         grow(((count div growsize)+1)*growsize);
-        Assert(not assigned(data^[p.FIndexnr]) or (p=data^[p.FIndexnr]));
-        data^[p.FIndexnr]:=p;
-        { update Linked List backward }
-        i:=p.FIndexnr;
-        while (i>0) do
-         begin
-           dec(i);
-           if (i>0) and assigned(data^[i]) then
-            begin
-              data^[i].FIndexNext:=p;
-              break;
-            end;
-         end;
-        if i=0 then
-         First:=p;
-        { update Linked List forward }
-        i:=p.FIndexnr;
-        while (i<=count) do
-         begin
-           inc(i);
-           if (i<=count) and assigned(data^[i]) then
-            begin
-              p.FIndexNext:=data^[i];
-              exit;
-            end;
-         end;
-        if i>count then
-         p.FIndexNext:=nil;
-      end;
-
-
-    procedure tindexarray.replace(oldp,newp:TNamedIndexItem);
-      var
-        i : integer;
-      begin
-        newp.FIndexnr:=oldp.FIndexnr;
-        newp.FIndexNext:=oldp.FIndexNext;
-        data^[newp.FIndexnr]:=newp;
-        if First=oldp then
-          First:=newp;
-        { update Linked List backward }
-        i:=newp.FIndexnr;
-        while (i>0) do
-         begin
-           dec(i);
-           if (i>0) and assigned(data^[i]) then
-            begin
-              data^[i].FIndexNext:=newp;
-              break;
-            end;
-         end;
-      end;
-
-
-{****************************************************************************
-                                tdynamicarray
-****************************************************************************}
-
-    constructor tdynamicarray.create(Ablocksize:integer);
-      begin
-        FPosn:=0;
-        FPosnblock:=nil;
-        FFirstblock:=nil;
-        FLastblock:=nil;
-        Fblocksize:=Ablocksize;
-        grow;
-      end;
-
-
-    destructor tdynamicarray.destroy;
-      var
-        hp : pdynamicblock;
-      begin
-        while assigned(FFirstblock) do
-         begin
-           hp:=FFirstblock;
-           FFirstblock:=FFirstblock^.Next;
-           Freemem(hp);
-         end;
-      end;
-
-
-    function  tdynamicarray.size:integer;
-      begin
-        if assigned(FLastblock) then
-         size:=FLastblock^.pos+FLastblock^.used
-        else
-         size:=0;
-      end;
-
-
-    procedure tdynamicarray.reset;
-      var
-        hp : pdynamicblock;
-      begin
-        while assigned(FFirstblock) do
-         begin
-           hp:=FFirstblock;
-           FFirstblock:=FFirstblock^.Next;
-           Freemem(hp);
-         end;
-        FPosn:=0;
-        FPosnblock:=nil;
-        FFirstblock:=nil;
-        FLastblock:=nil;
-        grow;
-      end;
-
-
-    procedure tdynamicarray.grow;
-      var
-        nblock : pdynamicblock;
-      begin
-        Getmem(nblock,blocksize+dynamicblockbasesize);
-        if not assigned(FFirstblock) then
-         begin
-           FFirstblock:=nblock;
-           FPosnblock:=nblock;
-           nblock^.pos:=0;
-         end
-        else
-         begin
-           FLastblock^.Next:=nblock;
-           nblock^.pos:=FLastblock^.pos+FLastblock^.used;
-         end;
-        nblock^.used:=0;
-        nblock^.Next:=nil;
-        fillchar(nblock^.data,blocksize,0);
-        FLastblock:=nblock;
-      end;
-
-
-    procedure tdynamicarray.align(i:integer);
-      var
-        j : integer;
-      begin
-        j:=(FPosn mod i);
-        if j<>0 then
-         begin
-           j:=i-j;
-           if FPosnblock^.used+j>blocksize then
-            begin
-              dec(j,blocksize-FPosnblock^.used);
-              FPosnblock^.used:=blocksize;
-              grow;
-              FPosnblock:=FLastblock;
-            end;
-           inc(FPosnblock^.used,j);
-           inc(FPosn,j);
-         end;
-      end;
-
-
-    procedure tdynamicarray.seek(i:integer);
-      begin
-        if (i<FPosnblock^.pos) or (i>=FPosnblock^.pos+blocksize) then
-         begin
-           { set FPosnblock correct if the size is bigger then
-             the current block }
-           if FPosnblock^.pos>i then
-            FPosnblock:=FFirstblock;
-           while assigned(FPosnblock) do
-            begin
-              if FPosnblock^.pos+blocksize>i then
-               break;
-              FPosnblock:=FPosnblock^.Next;
-            end;
-           { not found ? then increase blocks }
-           if not assigned(FPosnblock) then
-            begin
-              repeat
-                { the current FLastblock is now also fully used }
-                FLastblock^.used:=blocksize;
-                grow;
-                FPosnblock:=FLastblock;
-              until FPosnblock^.pos+blocksize>=i;
-            end;
-         end;
-        FPosn:=i;
-        if FPosn mod blocksize>FPosnblock^.used then
-         FPosnblock^.used:=FPosn mod blocksize;
-      end;
-
-
-    procedure tdynamicarray.write(const d;len:integer);
-      var
-        p : pchar;
-        i,j : integer;
-      begin
-        p:=pchar(@d);
-        while (len>0) do
-         begin
-           i:=FPosn mod blocksize;
-           if i+len>=blocksize then
-            begin
-              j:=blocksize-i;
-              move(p^,FPosnblock^.data[i],j);
-              inc(p,j);
-              inc(FPosn,j);
-              dec(len,j);
-              FPosnblock^.used:=blocksize;
-              if assigned(FPosnblock^.Next) then
-               FPosnblock:=FPosnblock^.Next
-              else
-               begin
-                 grow;
-                 FPosnblock:=FLastblock;
-               end;
-            end
-           else
-            begin
-              move(p^,FPosnblock^.data[i],len);
-              inc(p,len);
-              inc(FPosn,len);
-              i:=FPosn mod blocksize;
-              if i>FPosnblock^.used then
-               FPosnblock^.used:=i;
-              len:=0;
-            end;
-         end;
-      end;
-
-
-    procedure tdynamicarray.writestr(const s:string);
-      begin
-        write(s[1],length(s));
-      end;
-
-
-    function tdynamicarray.read(var d;len:integer):integer;
-      var
-        p : pchar;
-        i,j,res : integer;
-      begin
-        res:=0;
-        p:=pchar(@d);
-        while (len>0) do
-         begin
-           i:=FPosn mod blocksize;
-           if i+len>=FPosnblock^.used then
-            begin
-              j:=FPosnblock^.used-i;
-              move(FPosnblock^.data[i],p^,j);
-              inc(p,j);
-              inc(FPosn,j);
-              inc(res,j);
-              dec(len,j);
-              if assigned(FPosnblock^.Next) then
-               FPosnblock:=FPosnblock^.Next
-              else
-               break;
-            end
-           else
-            begin
-              move(FPosnblock^.data[i],p^,len);
-              inc(p,len);
-              inc(FPosn,len);
-              inc(res,len);
-              len:=0;
-            end;
-         end;
-        read:=res;
-      end;
-
-
-    procedure tdynamicarray.readstream(f:TCStream;maxlen:longint);
-      var
-        i,left : integer;
-      begin
-        if maxlen=-1 then
-         maxlen:=maxlongint;
-        repeat
-          left:=blocksize-FPosnblock^.used;
-          if left>maxlen then
-           left:=maxlen;
-          i:=f.Read(FPosnblock^.data[FPosnblock^.used],left);
-          dec(maxlen,i);
-          inc(FPosnblock^.used,i);
-          if FPosnblock^.used=blocksize then
-           begin
-             if assigned(FPosnblock^.Next) then
-              FPosnblock:=FPosnblock^.Next
-             else
-              begin
-                grow;
-                FPosnblock:=FLastblock;
-              end;
-           end;
-        until (i<left) or (maxlen=0);
-      end;
-
-
-    procedure tdynamicarray.writestream(f:TCStream);
-      var
-        hp : pdynamicblock;
-      begin
-        hp:=FFirstblock;
-        while assigned(hp) do
-         begin
-           f.Write(hp^.data,hp^.used);
-           hp:=hp^.Next;
-         end;
-      end;
-
-
-end.

compiler/compiler/cg64f32.pas

@@ -1,791 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-    Member of the Free Pascal development team
-
-    This unit implements the code generation for 64 bit int
-    arithmethics on 32 bit processors
-
-    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 generation for 64 bit int arithmethics on
-   32 bit processors.
-}
-unit cg64f32;
-
-  {$i fpcdefs.inc}
-
-  interface
-
-    uses
-       aasmbase,aasmtai,aasmcpu,
-       cpubase,cpupara,
-       cgbase,cgobj,parabase,cgutils,
-       symtype
-       ;
-
-    type
-      {# Defines all the methods required on 32-bit processors
-         to handle 64-bit integers.
-      }
-      tcg64f32 = class(tcg64)
-        procedure a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);override;
-        procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
-        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
-        procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);override;
-        procedure a_load64_const_reg(list : taasmoutput;value: int64;reg : tregister64);override;
-        procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);override;
-        procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
-        procedure a_load64_const_loc(list : taasmoutput;value : int64;const l : tlocation);override;
-        procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
-
-        procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
-        procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
-        procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
-        procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
-        procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
-        procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
-
-        procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override;
-        procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;size : tcgsize;reg : tregister64; const ref: treference);override;
-        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);override;
-        procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);override;
-        procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;size : tcgsize;const l : tlocation;reg : tregister64);override;
-        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;const ref : treference);override;
-
-        procedure a_param64_reg(list : taasmoutput;reg : tregister64;const paraloc : tcgpara);override;
-        procedure a_param64_const(list : taasmoutput;value : int64;const paraloc : tcgpara);override;
-        procedure a_param64_ref(list : taasmoutput;const r : treference;const paraloc : tcgpara);override;
-        procedure a_param64_loc(list : taasmoutput;const l : tlocation;const paraloc : tcgpara);override;
-
-        {# This routine tries to optimize the a_op64_const_reg operation, by
-           removing superfluous opcodes. Returns TRUE if normal processing
-           must continue in op64_const_reg, otherwise, everything is processed
-           entirely in this routine, by emitting the appropriate 32-bit opcodes.
-        }
-        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : int64; var reg: tregister64): boolean;override;
-
-        procedure g_rangecheck64(list: taasmoutput; const l:tlocation;fromdef,todef: tdef); override;
-      end;
-
-    {# Creates a tregister64 record from 2 32 Bit registers. }
-    function joinreg64(reglo,reghi : tregister) : tregister64;
-
-  implementation
-
-    uses
-       globtype,systems,
-       verbose,
-       symbase,symconst,symdef,defutil,paramgr;
-
-{****************************************************************************
-                                     Helpers
-****************************************************************************}
-
-    function joinreg64(reglo,reghi : tregister) : tregister64;
-      begin
-         result.reglo:=reglo;
-         result.reghi:=reghi;
-      end;
-
-
-    procedure swap64(var q : int64);
-      begin
-         q:=(int64(lo(q)) shl 32) or hi(q);
-      end;
-
-
-    procedure splitparaloc64(const cgpara:tcgpara;var cgparalo,cgparahi:tcgpara);
-      var
-        paraloclo,
-        paralochi : pcgparalocation;
-      begin
-        if not(cgpara.size in [OS_64,OS_S64]) then
-          internalerror(200408231);
-        if not assigned(cgpara.location) then
-          internalerror(200408201);
-        { init lo/hi para }
-        cgparahi.reset;
-        if cgpara.size=OS_S64 then
-          cgparahi.size:=OS_S32
-        else
-          cgparahi.size:=OS_32;
-        cgparahi.intsize:=4;
-        cgparahi.alignment:=cgpara.alignment;
-        paralochi:=cgparahi.add_location;
-        cgparalo.reset;
-        cgparalo.size:=OS_32;
-        cgparalo.intsize:=4;
-        cgparalo.alignment:=cgpara.alignment;
-        paraloclo:=cgparalo.add_location;
-        { 2 parameter fields? }
-        if assigned(cgpara.location^.next) then
-          begin
-            { Order for multiple locations is always
-                paraloc^ -> high
-                paraloc^.next -> low }
-            if (target_info.endian=ENDIAN_BIG) then
-              begin
-                { paraloc^ -> high
-                  paraloc^.next -> low }
-                move(cgpara.location^,paralochi^,sizeof(paralochi^));
-                move(cgpara.location^.next^,paraloclo^,sizeof(paraloclo^));
-              end
-            else
-              begin
-                { paraloc^ -> low
-                  paraloc^.next -> high }
-                move(cgpara.location^,paraloclo^,sizeof(paraloclo^));
-                move(cgpara.location^.next^,paralochi^,sizeof(paralochi^));
-              end;
-          end
-        else
-          begin
-            { single parameter, this can only be in memory }
-            if cgpara.location^.loc<>LOC_REFERENCE then
-              internalerror(200408282);
-            move(cgpara.location^,paraloclo^,sizeof(paraloclo^));
-            move(cgpara.location^,paralochi^,sizeof(paralochi^));
-            { for big endian low is at +4, for little endian high }
-            if target_info.endian = endian_big then
-              inc(cgparalo.location^.reference.offset,4)
-            else
-              inc(cgparahi.location^.reference.offset,4);
-          end;
-        { fix size }
-        paraloclo^.size:=cgparalo.size;
-        paraloclo^.next:=nil;
-        paralochi^.size:=cgparahi.size;
-        paralochi^.next:=nil;
-      end;
-
-
-{****************************************************************************
-                                   TCG64F32
-****************************************************************************}
-
-    procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
-      var
-        tmpreg: tregister;
-        tmpref: treference;
-      begin
-        if target_info.endian = endian_big then
-          begin
-            tmpreg:=reg.reglo;
-            reg.reglo:=reg.reghi;
-            reg.reghi:=tmpreg;
-          end;
-        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,ref);
-        tmpref := ref;
-        inc(tmpref.offset,4);
-        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
-      end;
-
-
-    procedure tcg64f32.a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);
-      var
-        tmpref: treference;
-      begin
-        if target_info.endian = endian_big then
-          swap64(value);
-        cg.a_load_const_ref(list,OS_32,aint(lo(value)),ref);
-        tmpref := ref;
-        inc(tmpref.offset,4);
-        cg.a_load_const_ref(list,OS_32,aint(hi(value)),tmpref);
-      end;
-
-
-    procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);
-      var
-        tmpreg: tregister;
-        tmpref: treference;
-      begin
-        if target_info.endian = endian_big then
-          begin
-            tmpreg := reg.reglo;
-            reg.reglo := reg.reghi;
-            reg.reghi := tmpreg;
-          end;
-        tmpref := ref;
-        if (tmpref.base=reg.reglo) then
-         begin
-           tmpreg:=cg.getaddressregister(list);
-           cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.base,tmpreg);
-           tmpref.base:=tmpreg;
-         end
-        else
-         { this works only for the i386, thus the i386 needs to override  }
-         { this method and this method must be replaced by a more generic }
-         { implementation FK                                              }
-         if (tmpref.index=reg.reglo) then
-          begin
-            tmpreg:=cg.getaddressregister(list);
-            cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.index,tmpreg);
-            tmpref.index:=tmpreg;
-          end;
-        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
-        inc(tmpref.offset,4);
-        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
-      end;
-
-
-    procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);
-
-      begin
-        cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);
-        cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reghi,regdst.reghi);
-      end;
-
-
-    procedure tcg64f32.a_load64_const_reg(list : taasmoutput;value : int64;reg : tregister64);
-
-      begin
-        cg.a_load_const_reg(list,OS_32,aint(lo(value)),reg.reglo);
-        cg.a_load_const_reg(list,OS_32,aint(hi(value)),reg.reghi);
-      end;
-
-
-    procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);
-
-      begin
-        case l.loc of
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_load64_ref_reg(list,l.reference,reg);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load64_reg_reg(list,l.register64,reg);
-          LOC_CONSTANT :
-            a_load64_const_reg(list,l.value64,reg);
-          else
-            internalerror(200112292);
-        end;
-      end;
-
-
-    procedure tcg64f32.a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);
-      begin
-        case l.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load64_reg_ref(list,l.register64,ref);
-          LOC_CONSTANT :
-            a_load64_const_ref(list,l.value64,ref);
-          else
-            internalerror(200203288);
-        end;
-      end;
-
-
-    procedure tcg64f32.a_load64_const_loc(list : taasmoutput;value : int64;const l : tlocation);
-
-      begin
-        case l.loc of
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_load64_const_ref(list,value,l.reference);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load64_const_reg(list,value,l.register64);
-          else
-            internalerror(200112293);
-        end;
-      end;
-
-
-    procedure tcg64f32.a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);
-
-      begin
-        case l.loc of
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_load64_reg_ref(list,reg,l.reference);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load64_reg_reg(list,reg,l.register64);
-          else
-            internalerror(200112293);
-        end;
-      end;
-
-
-    procedure tcg64f32.a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
-      var
-        tmpref: treference;
-      begin
-        if target_info.endian = endian_big then
-          cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
-        else
-          begin
-            tmpref := ref;
-            inc(tmpref.offset,4);
-            cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
-          end;
-      end;
-
-    procedure tcg64f32.a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
-      var
-        tmpref: treference;
-      begin
-        if target_info.endian = endian_little then
-          cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
-        else
-          begin
-            tmpref := ref;
-            inc(tmpref.offset,4);
-            cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
-          end;
-      end;
-
-
-    procedure tcg64f32.a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
-      var
-        tmpref: treference;
-      begin
-        if target_info.endian = endian_big then
-          cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
-        else
-          begin
-            tmpref := ref;
-            inc(tmpref.offset,4);
-            cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
-          end;
-      end;
-
-
-    procedure tcg64f32.a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
-      var
-        tmpref: treference;
-      begin
-        if target_info.endian = endian_little then
-          cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
-        else
-          begin
-            tmpref := ref;
-            inc(tmpref.offset,4);
-            cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
-          end;
-      end;
-
-
-    procedure tcg64f32.a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
-      begin
-        case l.loc of
-          LOC_REFERENCE,
-          LOC_CREFERENCE :
-            a_load64low_ref_reg(list,l.reference,reg);
-          LOC_REGISTER,
-          LOC_CREGISTER :
-            cg.a_load_reg_reg(list,OS_32,OS_32,l.register64.reglo,reg);
-          LOC_CONSTANT :
-            cg.a_load_const_reg(list,OS_32,aint(lo(l.value64)),reg);
-          else
-            internalerror(200203244);
-        end;
-      end;
-
-
-    procedure tcg64f32.a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
-      begin
-        case l.loc of
-          LOC_REFERENCE,
-          LOC_CREFERENCE :
-            a_load64high_ref_reg(list,l.reference,reg);
-          LOC_REGISTER,
-          LOC_CREGISTER :
-            cg.a_load_reg_reg(list,OS_32,OS_32,l.register64.reghi,reg);
-          LOC_CONSTANT :
-            cg.a_load_const_reg(list,OS_32,hi(l.value64),reg);
-          else
-            internalerror(200203244);
-        end;
-      end;
-
-
-    procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);
-      begin
-        case l.loc of
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_op64_const_ref(list,op,size,value,l.reference);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_op64_const_reg(list,op,size,value,l.register64);
-          else
-            internalerror(200203292);
-        end;
-      end;
-
-
-    procedure tcg64f32.a_op64_reg_loc(list : taasmoutput;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);
-      begin
-        case l.loc of
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_op64_reg_ref(list,op,size,reg,l.reference);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_op64_reg_reg(list,op,size,reg,l.register64);
-          else
-            internalerror(2002032422);
-        end;
-      end;
-
-
-
-    procedure tcg64f32.a_op64_loc_reg(list : taasmoutput;op:TOpCG;size : tcgsize;const l : tlocation;reg : tregister64);
-      begin
-        case l.loc of
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_op64_ref_reg(list,op,size,l.reference,reg);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_op64_reg_reg(list,op,size,l.register64,reg);
-          LOC_CONSTANT :
-            a_op64_const_reg(list,op,size,l.value64,reg);
-          else
-            internalerror(200203242);
-        end;
-      end;
-
-
-    procedure tcg64f32.a_op64_ref_reg(list : taasmoutput;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);
-      var
-        tempreg: tregister64;
-      begin
-        tempreg.reghi:=cg.getintregister(list,OS_32);
-        tempreg.reglo:=cg.getintregister(list,OS_32);
-        a_load64_ref_reg(list,ref,tempreg);
-        a_op64_reg_reg(list,op,size,tempreg,reg);
-      end;
-
-
-    procedure tcg64f32.a_op64_reg_ref(list : taasmoutput;op:TOpCG;size : tcgsize;reg : tregister64; const ref: treference);
-      var
-        tempreg: tregister64;
-      begin
-        tempreg.reghi:=cg.getintregister(list,OS_32);
-        tempreg.reglo:=cg.getintregister(list,OS_32);
-        a_load64_ref_reg(list,ref,tempreg);
-        a_op64_reg_reg(list,op,size,reg,tempreg);
-        a_load64_reg_ref(list,tempreg,ref);
-      end;
-
-
-    procedure tcg64f32.a_op64_const_ref(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;const ref : treference);
-      var
-        tempreg: tregister64;
-      begin
-        tempreg.reghi:=cg.getintregister(list,OS_32);
-        tempreg.reglo:=cg.getintregister(list,OS_32);
-        a_load64_ref_reg(list,ref,tempreg);
-        a_op64_const_reg(list,op,size,value,tempreg);
-        a_load64_reg_ref(list,tempreg,ref);
-      end;
-
-
-    procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const paraloc : tcgpara);
-      var
-        tmplochi,tmploclo: tcgpara;
-      begin
-        tmploclo.init;
-        tmplochi.init;
-        splitparaloc64(paraloc,tmploclo,tmplochi);
-        { Keep this order of first hi before lo to have
-          the correct push order for i386 }
-        cg.a_param_reg(list,OS_32,reg.reghi,tmplochi);
-        cg.a_param_reg(list,OS_32,reg.reglo,tmploclo);
-        tmploclo.done;
-        tmplochi.done;
-      end;
-
-
-    procedure tcg64f32.a_param64_const(list : taasmoutput;value : int64;const paraloc : tcgpara);
-      var
-        tmplochi,tmploclo: tcgpara;
-      begin
-        tmploclo.init;
-        tmplochi.init;
-        splitparaloc64(paraloc,tmploclo,tmplochi);
-        { Keep this order of first hi before lo to have
-          the correct push order for i386 }
-        cg.a_param_const(list,OS_32,aint(hi(value)),tmplochi);
-        cg.a_param_const(list,OS_32,aint(lo(value)),tmploclo);
-        tmploclo.done;
-        tmplochi.done;
-      end;
-
-
-    procedure tcg64f32.a_param64_ref(list : taasmoutput;const r : treference;const paraloc : tcgpara);
-      var
-        tmprefhi,tmpreflo : treference;
-        tmploclo,tmplochi : tcgpara;
-      begin
-        tmploclo.init;
-        tmplochi.init;
-        splitparaloc64(paraloc,tmploclo,tmplochi);
-        tmprefhi:=r;
-        tmpreflo:=r;
-        if target_info.endian=endian_big then
-          inc(tmpreflo.offset,4)
-        else
-          inc(tmprefhi.offset,4);
-        { Keep this order of first hi before lo to have
-          the correct push order for i386 }
-        cg.a_param_ref(list,OS_32,tmprefhi,tmplochi);
-        cg.a_param_ref(list,OS_32,tmpreflo,tmploclo);
-        tmploclo.done;
-        tmplochi.done;
-      end;
-
-
-    procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const paraloc : tcgpara);
-      begin
-        case l.loc of
-          LOC_REGISTER,
-          LOC_CREGISTER :
-            a_param64_reg(list,l.register64,paraloc);
-          LOC_CONSTANT :
-            a_param64_const(list,l.value64,paraloc);
-          LOC_CREFERENCE,
-          LOC_REFERENCE :
-            a_param64_ref(list,l.reference,paraloc);
-          else
-            internalerror(200203287);
-        end;
-      end;
-
-
-    procedure tcg64f32.g_rangecheck64(list : taasmoutput;const l:tlocation;fromdef,todef:tdef);
-
-      var
-        neglabel,
-        poslabel,
-        endlabel: tasmlabel;
-        hreg   : tregister;
-        hdef   :  torddef;
-        opsize   : tcgsize;
-        oldregisterdef: boolean;
-        from_signed,to_signed: boolean;
-        temploc : tlocation;
-
-      begin
-         from_signed := is_signed(fromdef);
-         to_signed := is_signed(todef);
-
-         if not is_64bit(todef) then
-           begin
-             oldregisterdef := registerdef;
-             registerdef := false;
-
-             { get the high dword in a register }
-             if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
-               begin
-                 hreg := l.register64.reghi;
-               end
-             else
-               begin
-                 hreg:=cg.getintregister(list,OS_32);
-                 a_load64high_ref_reg(list,l.reference,hreg);
-               end;
-             objectlibrary.getjumplabel(poslabel);
-
-             { check high dword, must be 0 (for positive numbers) }
-             cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
-
-             { It can also be $ffffffff, but only for negative numbers }
-             if from_signed and to_signed then
-               begin
-                 objectlibrary.getjumplabel(neglabel);
-                 cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel);
-               end;
-             { For all other values we have a range check error }
-             cg.a_call_name(list,'FPC_RANGEERROR');
-
-             { if the high dword = 0, the low dword can be considered a }
-             { simple cardinal                                          }
-             cg.a_label(list,poslabel);
-             hdef:=torddef.create(u32bit,0,$ffffffff);
-
-             location_copy(temploc,l);
-             temploc.size:=OS_32;
-
-             if (temploc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
-                (target_info.endian = endian_big) then
-               inc(temploc.reference.offset,4);
-
-             cg.g_rangecheck(list,temploc,hdef,todef);
-             hdef.free;
-
-             if from_signed and to_signed then
-               begin
-                 objectlibrary.getjumplabel(endlabel);
-                 cg.a_jmp_always(list,endlabel);
-                 { if the high dword = $ffffffff, then the low dword (when }
-                 { considered as a longint) must be < 0                    }
-                 cg.a_label(list,neglabel);
-                 if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                   begin
-                     hreg := l.register64.reglo;
-                   end
-                 else
-                   begin
-                     hreg:=cg.getintregister(list,OS_32);
-                     a_load64low_ref_reg(list,l.reference,hreg);
-                   end;
-                 { get a new neglabel (JM) }
-                 objectlibrary.getjumplabel(neglabel);
-                 cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
-
-                 cg.a_call_name(list,'FPC_RANGEERROR');
-
-                 { if we get here, the 64bit value lies between }
-                 { longint($80000000) and -1 (JM)               }
-                 cg.a_label(list,neglabel);
-                 hdef:=torddef.create(s32bit,longint($80000000),-1);
-                 location_copy(temploc,l);
-                 temploc.size:=OS_32;
-                 cg.g_rangecheck(list,temploc,hdef,todef);
-                 hdef.free;
-                 cg.a_label(list,endlabel);
-               end;
-             registerdef := oldregisterdef;
-           end
-         else
-           { todef = 64bit int }
-           { no 64bit subranges supported, so only a small check is necessary }
-
-           { if both are signed or both are unsigned, no problem! }
-           if (from_signed xor to_signed) and
-              { also not if the fromdef is unsigned and < 64bit, since that will }
-              { always fit in a 64bit int (todef is 64bit)                       }
-              (from_signed or
-               (torddef(fromdef).typ = u64bit)) then
-             begin
-               { in all cases, there is only a problem if the higest bit is set }
-               if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                 begin
-                   if is_64bit(fromdef) then
-                     begin
-                       hreg := l.register64.reghi;
-                       opsize := OS_32;
-                     end
-                   else
-                     begin
-                       hreg := l.register;
-                       opsize := def_cgsize(fromdef);
-                     end;
-                 end
-               else
-                 begin
-                   hreg:=cg.getintregister(list,OS_32);
-
-                   opsize := def_cgsize(fromdef);
-                   if opsize in [OS_64,OS_S64] then
-                     a_load64high_ref_reg(list,l.reference,hreg)
-                   else
-                     cg.a_load_ref_reg(list,opsize,OS_32,l.reference,hreg);
-                 end;
-               objectlibrary.getjumplabel(poslabel);
-               cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
-
-               cg.a_call_name(list,'FPC_RANGEERROR');
-               cg.a_label(list,poslabel);
-             end;
-      end;
-
-
-    function tcg64f32.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : int64; var reg: tregister64): boolean;
-      var
-        lowvalue, highvalue : longint;
-        hreg: tregister;
-      begin
-        lowvalue := longint(a);
-        highvalue:= longint(a shr 32);
-        { assume it will be optimized out }
-        optimize64_op_const_reg := true;
-        case op of
-        OP_ADD:
-           begin
-             if a = 0 then
-                exit;
-           end;
-        OP_AND:
-           begin
-              if lowvalue <> -1 then
-                cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
-              if highvalue <> -1 then
-                cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
-              { already emitted correctly }
-              exit;
-           end;
-        OP_OR:
-           begin
-              if lowvalue <> 0 then
-                cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
-              if highvalue <> 0 then
-                cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
-              { already emitted correctly }
-              exit;
-           end;
-        OP_SUB:
-           begin
-             if a = 0 then
-                exit;
-           end;
-        OP_XOR:
-           begin
-           end;
-        OP_SHL:
-           begin
-             if a = 0 then
-                 exit;
-             { simply clear low-register
-               and shift the rest and swap
-               registers.
-             }
-             if (a > 31) then
-               begin
-                 cg.a_load_const_reg(list,OS_32,0,reg.reglo);
-                 cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reghi);
-                 { swap the registers }
-                 hreg := reg.reghi;
-                 reg.reghi := reg.reglo;
-                 reg.reglo := hreg;
-                 exit;
-               end;
-           end;
-        OP_SHR:
-           begin
-             if a = 0 then exit;
-             { simply clear high-register
-               and shift the rest and swap
-               registers.
-             }
-             if (a > 31) then
-               begin
-                 cg.a_load_const_reg(list,OS_32,0,reg.reghi);
-                 cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reglo);
-                 { swap the registers }
-                 hreg := reg.reghi;
-                 reg.reghi := reg.reglo;
-                 reg.reglo := hreg;
-                 exit;
-               end;
-           end;
-        OP_IMUL,OP_MUL:
-           begin
-             if a = 1 then exit;
-           end;
-        OP_IDIV,OP_DIV:
-            begin
-             if a = 1 then exit;
-            end;
-        else
-           internalerror(20020817);
-        end;
-        optimize64_op_const_reg := false;
-      end;
-
-end.

compiler/compiler/cgbase.pas

@@ -1,605 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    Some basic types and constants for the code generation
-
-    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 exports some types which are used across the code generator }
-unit cgbase;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      globtype,
-      symconst;
-
-    type
-       { Location types where value can be stored }
-       TCGLoc=(
-         LOC_INVALID,      { added for tracking problems}
-         LOC_VOID,         { no value is available }
-         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_MMXREGISTER,  { MMX register }
-         { MMX register variable }
-         LOC_CMMXREGISTER,
-         { multimedia register }
-         LOC_MMREGISTER,
-         { Constant multimedia reg which shouldn't be modified }
-         LOC_CMMREGISTER
-       );
-
-       { since we have only 16bit offsets, we need to be able to specify the high
-         and lower 16 bits of the address of a symbol of up to 64 bit }
-       trefaddr = (
-         addr_no,
-         addr_full,
-         {$IFNDEF POWERPC64}
-         addr_hi,
-         addr_lo,
-         {$ENDIF}
-         addr_pic
-         {$IFDEF POWERPC64}
-         ,
-         addr_low,         // bits 48-63
-         addr_high,        // bits 32-47
-         addr_higher,      // bits 16-31
-         addr_highest,     // bits 00-15
-         addr_higha,       // bits 16-31, adjusted
-         addr_highera,     // bits 32-47, adjusted
-         addr_highesta     // bits 48-63, adjusted
-         {$ENDIF}
-         );
-
-
-       {# Generic opcodes, which must be supported by all processors
-       }
-       topcg =
-       (
-          OP_NONE,
-          OP_ADD,       { simple addition          }
-          OP_AND,       { simple logical and       }
-          OP_DIV,       { simple unsigned division }
-          OP_IDIV,      { simple signed division   }
-          OP_IMUL,      { simple signed multiply   }
-          OP_MUL,       { simple unsigned multiply }
-          OP_NEG,       { simple negate            }
-          OP_NOT,       { simple logical not       }
-          OP_OR,        { simple logical or        }
-          OP_SAR,       { arithmetic shift-right   }
-          OP_SHL,       { logical shift left       }
-          OP_SHR,       { logical shift right      }
-          OP_SUB,       { simple subtraction       }
-          OP_XOR        { simple exclusive or      }
-        );
-
-       {# Generic flag values - used for jump locations }
-       TOpCmp =
-       (
-          OC_NONE,
-          OC_EQ,           { equality comparison              }
-          OC_GT,           { greater than (signed)            }
-          OC_LT,           { less than (signed)               }
-          OC_GTE,          { greater or equal than (signed)   }
-          OC_LTE,          { less or equal than (signed)      }
-          OC_NE,           { not equal                        }
-          OC_BE,           { less or equal than (unsigned)    }
-          OC_B,            { less than (unsigned)             }
-          OC_AE,           { greater or equal than (unsigned) }
-          OC_A             { greater than (unsigned)          }
-        );
-
-       { OS_NO is also used memory references with large data that can
-         not be loaded in a register directly }
-       TCgSize = (OS_NO,
-                 { integer registers }
-                  OS_8,OS_16,OS_32,OS_64,OS_128,OS_S8,OS_S16,OS_S32,OS_S64,OS_S128,
-                 { single,double,extended,comp,float128 }
-                  OS_F32,OS_F64,OS_F80,OS_C64,OS_F128,
-                 { multi-media sizes: split in byte, word, dword, ... }
-                 { entities, then the signed counterparts             }
-                  OS_M8,OS_M16,OS_M32,OS_M64,OS_M128,
-                  OS_MS8,OS_MS16,OS_MS32,OS_MS64,OS_MS128);
-
-      { Register types }
-      TRegisterType = (
-        R_INVALIDREGISTER, { = 0 }
-        R_INTREGISTER,     { = 1 }
-        R_FPUREGISTER,     { = 2 }
-        { used by Intel only }
-        R_MMXREGISTER,     { = 3 }
-        R_MMREGISTER,      { = 4 }
-        R_SPECIALREGISTER, { = 5 }
-        R_ADDRESSREGISTER  { = 6 }
-      );
-
-      { Sub registers }
-      TSubRegister = (
-        R_SUBNONE, { = 0; no sub register possible }
-        R_SUBL,    { = 1; 8 bits, Like AL }
-        R_SUBH,    { = 2; 8 bits, Like AH }
-        R_SUBW,    { = 3; 16 bits, Like AX }
-        R_SUBD,    { = 4; 32 bits, Like EAX }
-        R_SUBQ,    { = 5; 64 bits, Like RAX }
-        { For Sparc floats that use F0:F1 to store doubles }
-        R_SUBFS,   { = 6; Float that allocates 1 FPU register }
-        R_SUBFD,   { = 7; Float that allocates 2 FPU registers }
-        R_SUBFQ,   { = 8; Float that allocates 4 FPU registers }
-        R_SUBMMS,  { = 9; single scalar in multi media register }
-        R_SUBMMD   { = 10; double scalar in multi media register }
-      );
-
-      TSuperRegister = type word;
-
-      {
-        The new register coding:
-
-        SuperRegister   (bits 0..15)
-        Subregister     (bits 16..23)
-        Register type   (bits 24..31)
-
-        TRegister is defined as an enum to make it incompatible
-        with TSuperRegister to avoid mixing them
-      }
-      TRegister = (
-        TRegisterLowEnum := Low(longint),
-        TRegisterHighEnum := High(longint)
-      );
-      TRegisterRec=packed record
-{$ifdef FPC_BIG_ENDIAN}
-         regtype : Tregistertype;
-         subreg  : Tsubregister;
-         supreg  : Tsuperregister;
-{$else FPC_BIG_ENDIAN}
-         supreg  : Tsuperregister;
-         subreg  : Tsubregister;
-         regtype : Tregistertype;
-{$endif FPC_BIG_ENDIAN}
-      end;
-
-      { A type to store register locations for 64 Bit values. }
-{$ifdef cpu64bit}
-      tregister64 = tregister;
-{$else cpu64bit}
-      tregister64 = record
-         reglo,reghi : tregister;
-      end;
-{$endif cpu64bit}
-
-      Tregistermmxset = record
-        reg0,reg1,reg2,reg3:Tregister
-      end;
-
-      { Set type definition for registers }
-      tcpuregisterset = set of byte;
-      tsuperregisterset = array[byte] of set of byte;
-
-      pmmshuffle = ^tmmshuffle;
-
-      { this record describes shuffle operations for mm operations; if a pointer a shuffle record
-        passed to an mm operation is nil, it means that the whole location is moved }
-      tmmshuffle = record
-        { describes how many shuffles are actually described, if len=0 then
-          moving the scalar with index 0 to the scalar with index 0 is meant }
-        len : byte;
-        { lower nibble of each entry of this array describes index of the source data index while
-          the upper nibble describes the destination index }
-        shuffles : array[1..1] of byte;
-      end;
-
-      Tsuperregisterarray=array[0..$ffff] of Tsuperregister;
-      Psuperregisterarray=^Tsuperregisterarray;
-
-      Tsuperregisterworklist=object
-        buflength,
-        buflengthinc,
-        length:word;
-        buf:Psuperregisterarray;
-        constructor init;
-        constructor copyfrom(const x:Tsuperregisterworklist);
-        destructor  done;
-        procedure clear;
-        procedure add(s:tsuperregister);
-        function get:tsuperregister;
-        procedure deleteidx(i:word);
-        function delete(s:tsuperregister):boolean;
-      end;
-      psuperregisterworklist=^tsuperregisterworklist;
-
-    const
-       { alias for easier understanding }
-       R_SSEREGISTER = R_MMREGISTER;
-
-       { Invalid register number }
-       RS_INVALID    = high(tsuperregister);
-
-       { Maximum number of cpu registers per register type,
-         this must fit in tcpuregisterset }
-       maxcpuregister = 32;
-
-       tcgsize2size : Array[tcgsize] of integer =
-         { integer values }
-        (0,1,2,4,8,16,1,2,4,8,16,
-         { floating point values }
-         4,8,10,8,16,
-         { multimedia values }
-         1,2,4,8,16,1,2,4,8,16);
-
-       tfloat2tcgsize: array[tfloattype] of tcgsize =
-         (OS_F32,OS_F64,OS_F80,OS_C64,OS_C64,OS_F128);
-
-       tcgsize2tfloat: array[OS_F32..OS_C64] of tfloattype =
-         (s32real,s64real,s80real,s64comp);
-
-       { Table to convert tcgsize variables to the correspondending
-         unsigned types }
-       tcgsize2unsigned : array[tcgsize] of tcgsize = (OS_NO,
-          OS_8,OS_16,OS_32,OS_64,OS_128,OS_8,OS_16,OS_32,OS_64,OS_128,
-          OS_F32,OS_F64,OS_F80,OS_C64,OS_F128,
-          OS_M8,OS_M16,OS_M32,OS_M64,OS_M128,OS_M8,OS_M16,OS_M32,
-          OS_M64,OS_M128);
-
-       tcgloc2str : array[TCGLoc] of string[11] = (
-            'LOC_INVALID',
-            'LOC_VOID',
-            'LOC_CONST',
-            'LOC_JUMP',
-            'LOC_FLAGS',
-            'LOC_CREF',
-            'LOC_REF',
-            'LOC_REG',
-            'LOC_CREG',
-            'LOC_FPUREG',
-            'LOC_CFPUREG',
-            'LOC_MMXREG',
-            'LOC_CMMXREG',
-            'LOC_MMREG',
-            'LOC_CMMREG');
-
-    var
-       mms_movescalar : pmmshuffle;
-
-    procedure supregset_reset(var regs:tsuperregisterset;setall:boolean;
-                              maxreg:Tsuperregister);{$ifdef USEINLINE}inline;{$endif}
-    procedure supregset_include(var regs:tsuperregisterset;s:tsuperregister);{$ifdef USEINLINE}inline;{$endif}
-    procedure supregset_exclude(var regs:tsuperregisterset;s:tsuperregister);{$ifdef USEINLINE}inline;{$endif}
-    function supregset_in(const regs:tsuperregisterset;s:tsuperregister):boolean;{$ifdef USEINLINE}inline;{$endif}
-
-    function newreg(rt:tregistertype;sr:tsuperregister;sb:tsubregister):tregister;{$ifdef USEINLINE}inline;{$endif}
-    function getsubreg(r:tregister):tsubregister;{$ifdef USEINLINE}inline;{$endif}
-    function getsupreg(r:tregister):tsuperregister;{$ifdef USEINLINE}inline;{$endif}
-    function getregtype(r:tregister):tregistertype;{$ifdef USEINLINE}inline;{$endif}
-    procedure setsubreg(var r:tregister;sr:tsubregister);{$ifdef USEINLINE}inline;{$endif}
-    procedure setsupreg(var r:tregister;sr:tsuperregister);{$ifdef USEINLINE}inline;{$endif}
-    function generic_regname(r:tregister):string;
-
-    {# From a constant numeric value, return the abstract code generator
-       size.
-    }
-    function int_cgsize(const a: aint): tcgsize;{$ifdef USEINLINE}inline;{$endif}
-
-    { return the inverse condition of opcmp }
-    function inverse_opcmp(opcmp: topcmp): topcmp;{$ifdef USEINLINE}inline;{$endif}
-
-    { return whether op is commutative }
-    function commutativeop(op: topcg): boolean;{$ifdef USEINLINE}inline;{$endif}
-
-    { returns true, if shuffle describes a real shuffle operation and not only a move }
-    function realshuffle(shuffle : pmmshuffle) : boolean;
-
-    { returns true, if the shuffle describes only a move of the scalar at index 0 }
-    function shufflescalar(shuffle : pmmshuffle) : boolean;
-
-    { removes shuffling from shuffle, this means that the destenation index of each shuffle is copied to
-      the source }
-    procedure removeshuffles(var shuffle : tmmshuffle);
-
-implementation
-
-    uses
-      verbose;
-
-{******************************************************************************
-                             tsuperregisterworklist
-******************************************************************************}
-
-    constructor tsuperregisterworklist.init;
-
-    begin
-      length:=0;
-      buflength:=0;
-      buflengthinc:=16;
-      buf:=nil;
-    end;
-
-    constructor Tsuperregisterworklist.copyfrom(const x:Tsuperregisterworklist);
-
-    begin
-      self:=x;
-      if x.buf<>nil then
-        begin
-          getmem(buf,buflength*sizeof(Tsuperregister));
-          move(x.buf^,buf^,length*sizeof(Tsuperregister));
-        end;
-    end;
-
-    destructor tsuperregisterworklist.done;
-
-    begin
-      if assigned(buf) then
-        freemem(buf);
-    end;
-
-
-    procedure tsuperregisterworklist.add(s:tsuperregister);
-
-    begin
-      inc(length);
-      { Need to increase buffer length? }
-      if length>=buflength then
-        begin
-          inc(buflength,buflengthinc);
-          buflengthinc:=buflengthinc*2;
-          if buflengthinc>256 then
-             buflengthinc:=256;
-          reallocmem(buf,buflength*sizeof(Tsuperregister));
-        end;
-      buf^[length-1]:=s;
-    end;
-
-
-    procedure tsuperregisterworklist.clear;
-
-    begin
-      length:=0;
-    end;
-
-
-    procedure tsuperregisterworklist.deleteidx(i:word);
-
-    begin
-      if length=0 then
-        internalerror(200310144);
-      buf^[i]:=buf^[length-1];
-      dec(length);
-    end;
-
-
-    function tsuperregisterworklist.get:tsuperregister;
-
-    begin
-      if length=0 then
-        internalerror(200310142);
-      get:=buf^[0];
-      buf^[0]:=buf^[length-1];
-      dec(length);
-    end;
-
-
-    function tsuperregisterworklist.delete(s:tsuperregister):boolean;
-
-    var
-      i:longint;
-
-    begin
-      delete:=false;
-      { indexword in 1.0.x and 1.9.4 is broken }
-      i:=indexword(buf^,length,s);
-      if i<>-1 then
-        begin
-          deleteidx(i);
-          delete := true;
-        end;
-    end;
-
-
-    procedure supregset_reset(var regs:tsuperregisterset;setall:boolean;
-                              maxreg:Tsuperregister);{$ifdef USEINLINE}inline;{$endif}
-
-    begin
-      fillchar(regs,(maxreg+7) shr 3,-byte(setall));
-    end;
-
-
-    procedure supregset_include(var regs:tsuperregisterset;s:tsuperregister);{$ifdef USEINLINE}inline;{$endif}
-      begin
-        include(regs[s shr 8],(s and $ff));
-      end;
-
-
-    procedure supregset_exclude(var regs:tsuperregisterset;s:tsuperregister);{$ifdef USEINLINE}inline;{$endif}
-      begin
-        exclude(regs[s shr 8],(s and $ff));
-      end;
-
-
-    function supregset_in(const regs:tsuperregisterset;s:tsuperregister):boolean;{$ifdef USEINLINE}inline;{$endif}
-      begin
-        result:=(s and $ff) in regs[s shr 8];
-      end;
-
-
-    function newreg(rt:tregistertype;sr:tsuperregister;sb:tsubregister):tregister;{$ifdef USEINLINE}inline;{$endif}
-      begin
-        tregisterrec(result).regtype:=rt;
-        tregisterrec(result).supreg:=sr;
-        tregisterrec(result).subreg:=sb;
-      end;
-
-
-    function getsubreg(r:tregister):tsubregister;{$ifdef USEINLINE}inline;{$endif}
-      begin
-        result:=tregisterrec(r).subreg;
-      end;
-
-
-    function getsupreg(r:tregister):tsuperregister;{$ifdef USEINLINE}inline;{$endif}
-      begin
-        result:=tregisterrec(r).supreg;
-      end;
-
-
-    function getregtype(r:tregister):tregistertype;{$ifdef USEINLINE}inline;{$endif}
-      begin
-        result:=tregisterrec(r).regtype;
-      end;
-
-
-    procedure setsubreg(var r:tregister;sr:tsubregister);{$ifdef USEINLINE}inline;{$endif}
-      begin
-        tregisterrec(r).subreg:=sr;
-      end;
-
-
-    procedure setsupreg(var r:tregister;sr:tsuperregister);{$ifdef USEINLINE}inline;{$endif}
-      begin
-        tregisterrec(r).supreg:=sr;
-      end;
-
-
-    function generic_regname(r:tregister):string;
-      var
-        nr : string[12];
-      begin
-        str(getsupreg(r),nr);
-        case getregtype(r) of
-          R_INTREGISTER:
-            result:='ireg'+nr;
-          R_FPUREGISTER:
-            result:='freg'+nr;
-          R_MMREGISTER:
-            result:='mreg'+nr;
-          R_MMXREGISTER:
-            result:='xreg'+nr;
-          else
-            begin
-              result:='INVALID';
-              exit;
-            end;
-        end;
-        case getsubreg(r) of
-          R_SUBNONE:
-            ;
-          R_SUBL:
-            result:=result+'l';
-          R_SUBH:
-            result:=result+'h';
-          R_SUBW:
-            result:=result+'w';
-          R_SUBD:
-            result:=result+'d';
-          R_SUBQ:
-            result:=result+'q';
-          R_SUBFS:
-            result:=result+'fs';
-          R_SUBFD:
-            result:=result+'fd';
-          R_SUBMMD:
-            result:=result+'md';
-          R_SUBMMS:
-            result:=result+'ms';
-          else
-            internalerror(200308252);
-        end;
-      end;
-
-
-    function int_cgsize(const a: aint): tcgsize;{$ifdef USEINLINE}inline;{$endif}
-      const
-        size2cgsize : array[0..8] of tcgsize = (
-          OS_NO,OS_8,OS_16,OS_32,OS_32,OS_64,OS_64,OS_64,OS_64
-        );
-      begin
-        if a>8 then
-          result:=OS_NO
-        else
-          result:=size2cgsize[a];
-      end;
-
-
-    function inverse_opcmp(opcmp: topcmp): topcmp;{$ifdef USEINLINE}inline;{$endif}
-      const
-        list: array[TOpCmp] of TOpCmp =
-          (OC_NONE,OC_NE,OC_LTE,OC_GTE,OC_LT,OC_GT,OC_EQ,OC_A,OC_AE,
-           OC_B,OC_BE);
-      begin
-        inverse_opcmp := list[opcmp];
-      end;
-
-
-    function commutativeop(op: topcg): boolean;{$ifdef USEINLINE}inline;{$endif}
-      const
-        list: array[topcg] of boolean =
-          (true,true,true,false,false,true,true,false,false,
-           true,false,false,false,false,true);
-      begin
-        commutativeop := list[op];
-      end;
-
-
-    function realshuffle(shuffle : pmmshuffle) : boolean;
-      var
-        i : longint;
-      begin
-        realshuffle:=true;
-        if (shuffle=nil) or (shuffle^.len=0) then
-          realshuffle:=false
-        else
-          begin
-            for i:=1 to shuffle^.len do
-              begin
-                if (shuffle^.shuffles[i] and $f)<>((shuffle^.shuffles[i] and $f0) shr 8) then
-                  exit;
-              end;
-            realshuffle:=false;
-          end;
-      end;
-
-
-    function shufflescalar(shuffle : pmmshuffle) : boolean;
-      begin
-        result:=shuffle^.len=0;
-      end;
-
-
-    procedure removeshuffles(var shuffle : tmmshuffle);
-      var
-        i : longint;
-      begin
-        if shuffle.len=0 then
-          exit;
-        for i:=1 to shuffle.len do
-          shuffle.shuffles[i]:=(shuffle.shuffles[i] and $f0) or ((shuffle.shuffles[i] and $f0) shr 8);
-      end;
-
-
-initialization
-  new(mms_movescalar);
-  mms_movescalar^.len:=0;
-finalization
-  dispose(mms_movescalar);
-end.

compiler/compiler/cgobj.pas

@@ -1,2090 +0,0 @@
-{
-    Copyright (c) 1998-2005 by Florian Klaempfl
-    Member of the Free Pascal development team
-
-    This unit implements the basic code generator 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.
-
- ****************************************************************************
-}
-{# @abstract(Abstract code generator unit)
-   Abstreact code generator unit. This contains the base class
-   to implement for all new supported processors.
-
-   WARNING: None of the routines implemented in these modules,
-   or their descendants, should use the temp. allocator, as
-   these routines may be called inside genentrycode, and the
-   stack frame is already setup!
-}
-unit cgobj;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-       cclasses,globtype,
-       cpubase,cgbase,cgutils,parabase,
-       aasmbase,aasmtai,aasmcpu,
-       symconst,symbase,symtype,symdef,symtable,rgobj
-       ;
-
-    type
-       talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
-
-       {# @abstract(Abstract code generator)
-          This class implements an abstract instruction generator. Some of
-          the methods of this class are generic, while others must
-          be overriden for all new processors which will be supported
-          by Free Pascal. For 32-bit processors, the base class
-          sould be @link(tcg64f32) and not @var(tcg).
-       }
-       tcg = class
-       public
-          alignment : talignment;
-          rg        : array[tregistertype] of trgobj;
-          t_times   : longint;
-       {$ifdef flowgraph}
-          aktflownode:word;
-       {$endif}
-          {************************************************}
-          {                 basic routines                 }
-          constructor create;
-
-          {# Initialize the register allocators needed for the codegenerator.}
-          procedure init_register_allocators;virtual;
-          {# Clean up the register allocators needed for the codegenerator.}
-          procedure done_register_allocators;virtual;
-
-       {$ifdef flowgraph}
-          procedure init_flowgraph;
-          procedure done_flowgraph;
-       {$endif}
-          {# Gets a register suitable to do integer operations on.}
-          function getintregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
-          {# Gets a register suitable to do integer operations on.}
-          function getaddressregister(list:Taasmoutput):Tregister;virtual;
-          function getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
-          function getmmregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;
-          function getflagregister(list:Taasmoutput;size:Tcgsize):Tregister;virtual;abstract;
-          {Does the generic cg need SIMD registers, like getmmxregister? Or should
-           the cpu specific child cg object have such a method?}
-
-          procedure add_reg_instruction(instr:Tai;r:tregister);virtual;
-          procedure add_move_instruction(instr:Taicpu);virtual;
-
-          function  uses_registers(rt:Tregistertype):boolean;virtual;
-          {# Get a specific register.}
-          procedure getcpuregister(list:Taasmoutput;r:Tregister);virtual;
-          procedure ungetcpuregister(list:Taasmoutput;r:Tregister);virtual;
-          {# Get multiple registers specified.}
-          procedure alloccpuregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);virtual;
-          {# Free multiple registers specified.}
-          procedure dealloccpuregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);virtual;
-
-          procedure allocallcpuregisters(list:Taasmoutput);virtual;
-          procedure deallocallcpuregisters(list:Taasmoutput);virtual;
-          procedure do_register_allocation(list:Taasmoutput;headertai:tai);virtual;
-
-          function makeregsize(list:Taasmoutput;reg:Tregister;size:Tcgsize):Tregister;
-
-          {# Emit a label to the instruction stream. }
-          procedure a_label(list : taasmoutput;l : tasmlabel);virtual;
-
-          {# Allocates register r by inserting a pai_realloc record }
-          procedure a_reg_alloc(list : taasmoutput;r : tregister);
-          {# Deallocates register r by inserting a pa_regdealloc record}
-          procedure a_reg_dealloc(list : taasmoutput;r : tregister);
-          { Synchronize register, make sure it is still valid }
-          procedure a_reg_sync(list : taasmoutput;r : tregister);
-
-          {# Pass a parameter, which is located in a register, to a routine.
-
-             This routine should push/send the parameter to the routine, as
-             required by the specific processor ABI and routine modifiers.
-             This must be overriden for each CPU target.
-
-             @param(size size of the operand in the register)
-             @param(r register source of the operand)
-             @param(cgpara where the parameter will be stored)
-          }
-          procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const cgpara : TCGPara);virtual;
-          {# Pass a parameter, which is a constant, to a routine.
-
-             A generic version is provided. This routine should
-             be overriden for optimization purposes if the cpu
-             permits directly sending this type of parameter.
-
-             @param(size size of the operand in constant)
-             @param(a value of constant to send)
-             @param(cgpara where the parameter will be stored)
-          }
-          procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const cgpara : TCGPara);virtual;
-          {# Pass the value of a parameter, which is located in memory, to a routine.
-
-             A generic version is provided. This routine should
-             be overriden for optimization purposes if the cpu
-             permits directly sending this type of parameter.
-
-             @param(size size of the operand in constant)
-             @param(r Memory reference of value to send)
-             @param(cgpara where the parameter will be stored)
-          }
-          procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const cgpara : TCGPara);virtual;
-          {# Pass the value of a parameter, which can be located either in a register or memory location,
-             to a routine.
-
-             A generic version is provided.
-
-             @param(l location of the operand to send)
-             @param(nr parameter number (starting from one) of routine (from left to right))
-             @param(cgpara where the parameter will be stored)
-          }
-          procedure a_param_loc(list : taasmoutput;const l : tlocation;const cgpara : TCGPara);
-          {# Pass the address of a reference to a routine. This routine
-             will calculate the address of the reference, and pass this
-             calculated address as a parameter.
-
-             A generic version is provided. This routine should
-             be overriden for optimization purposes if the cpu
-             permits directly sending this type of parameter.
-
-             @param(r reference to get address from)
-             @param(nr parameter number (starting from one) of routine (from left to right))
-          }
-          procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const cgpara : TCGPara);virtual;
-
-          { Remarks:
-            * If a method specifies a size you have only to take care
-              of that number of bits, i.e. load_const_reg with OP_8 must
-              only load the lower 8 bit of the specified register
-              the rest of the register can be undefined
-              if  necessary the compiler will call a method
-              to zero or sign extend the register
-            * The a_load_XX_XX with OP_64 needn't to be
-              implemented for 32 bit
-              processors, the code generator takes care of that
-            * the addr size is for work with the natural pointer
-              size
-            * the procedures without fpu/mm are only for integer usage
-            * normally the first location is the source and the
-              second the destination
-          }
-
-          {# Emits instruction to call the method specified by symbol name.
-             This routine must be overriden for each new target cpu.
-
-             There is no a_call_ref because loading the reference will use
-             a temp register on most cpu's resulting in conflicts with the
-             registers used for the parameters (PFV)
-          }
-          procedure a_call_name(list : taasmoutput;const s : string);virtual; abstract;
-          procedure a_call_reg(list : taasmoutput;reg : tregister);virtual;abstract;
-
-          { move instructions }
-          procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aint;register : tregister);virtual; abstract;
-          procedure a_load_const_ref(list : taasmoutput;size : tcgsize;a : aint;const ref : treference);virtual;
-          procedure a_load_const_loc(list : taasmoutput;a : aint;const loc : tlocation);
-          procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);virtual; abstract;
-          procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);virtual; abstract;
-          procedure a_load_reg_loc(list : taasmoutput;fromsize : tcgsize;reg : tregister;const loc: tlocation);
-          procedure a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);virtual; abstract;
-          procedure a_load_ref_ref(list : taasmoutput;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);virtual;
-          procedure a_load_loc_reg(list : taasmoutput;tosize: tcgsize; const loc: tlocation; reg : tregister);
-          procedure a_load_loc_ref(list : taasmoutput;tosize: tcgsize; const loc: tlocation; const ref : treference);
-          procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);virtual; abstract;
-
-          { fpu move instructions }
-          procedure a_loadfpu_reg_reg(list: taasmoutput; size:tcgsize; reg1, reg2: tregister); virtual; abstract;
-          procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); virtual; abstract;
-          procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); virtual; abstract;
-          procedure a_loadfpu_loc_reg(list: taasmoutput; const loc: tlocation; const reg: tregister);
-          procedure a_loadfpu_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation);
-          procedure a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const cgpara : TCGPara);virtual;
-          procedure a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const cgpara : TCGPara);virtual;
-
-          { vector register move instructions }
-          procedure a_loadmm_reg_reg(list: taasmoutput; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); virtual; abstract;
-          procedure a_loadmm_ref_reg(list: taasmoutput; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual; abstract;
-          procedure a_loadmm_reg_ref(list: taasmoutput; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); virtual; abstract;
-          procedure a_loadmm_loc_reg(list: taasmoutput; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);
-          procedure a_loadmm_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);
-          procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
-          procedure a_parammm_ref(list: taasmoutput; size: tcgsize; const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
-          procedure a_parammm_loc(list: taasmoutput; const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle); virtual;
-          procedure a_opmm_reg_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); virtual;abstract;
-          procedure a_opmm_ref_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual;
-          procedure a_opmm_loc_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const loc: tlocation; reg: tregister;shuffle : pmmshuffle); virtual;
-          procedure a_opmm_reg_ref(list: taasmoutput; Op: TOpCG; size : tcgsize;reg: tregister;const ref: treference; shuffle : pmmshuffle); virtual;
-
-          { basic arithmetic operations }
-          { note: for operators which require only one argument (not, neg), use }
-          { the op_reg_reg, op_reg_ref or op_reg_loc methods and keep in mind   }
-          { that in this case the *second* operand is used as both source and   }
-          { destination (JM)                                                    }
-          procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: Aint; reg: TRegister); virtual; abstract;
-          procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: Aint; const ref: TReference); virtual;
-          procedure a_op_const_loc(list : taasmoutput; Op: TOpCG; a: Aint; const loc: tlocation);
-          procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract;
-          procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); virtual;
-          procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual;
-          procedure a_op_reg_loc(list : taasmoutput; Op: TOpCG; reg: tregister; const loc: tlocation);
-          procedure a_op_ref_loc(list : taasmoutput; Op: TOpCG; const ref: TReference; const loc: tlocation);
-
-          { trinary operations for processors that support them, 'emulated' }
-          { on others. None with "ref" arguments since I don't think there  }
-          { are any processors that support it (JM)                         }
-          procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister); virtual;
-          procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); virtual;
-          procedure a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual;
-          procedure a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual;
-
-          {  comparison operations }
-          procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
-            l : tasmlabel);virtual; abstract;
-          procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;const ref : treference;
-            l : tasmlabel); virtual;
-          procedure a_cmp_const_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; a: aint; const loc: tlocation;
-            l : tasmlabel);
-          procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract;
-          procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual;
-          procedure a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); virtual;
-          procedure a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
-          procedure a_cmp_ref_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation;
-            l : tasmlabel);
-
-          procedure a_jmp_name(list : taasmoutput;const s : string); virtual; abstract;
-          procedure a_jmp_always(list : taasmoutput;l: tasmlabel); virtual; abstract;
-          procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); virtual; abstract;
-
-          {# Depending on the value to check in the flags, either sets the register reg to one (if the flag is set)
-             or zero (if the flag is cleared). The size parameter indicates the destination size register.
-          }
-          procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); virtual; abstract;
-          procedure g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference); virtual;
-
-          {
-             This routine tries to optimize the const_reg opcode, and should be
-             called at the start of a_op_const_reg. It returns the actual opcode
-             to emit, and the constant value to emit. If this routine returns
-             TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 )
-
-             @param(op The opcode to emit, returns the opcode which must be emitted)
-             @param(a  The constant which should be emitted, returns the constant which must
-                    be emitted)
-             @param(reg The register to emit the opcode with, returns the register with
-                   which the opcode will be emitted)
-          }
-          function optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aint; var reg: tregister): boolean;virtual;
-
-         {#
-             This routine is used in exception management nodes. It should
-             save the exception reason currently in the FUNCTION_RETURN_REG. The
-             save should be done either to a temp (pointed to by href).
-             or on the stack (pushing the value on the stack).
-
-             The size of the value to save is OS_S32. The default version
-             saves the exception reason to a temp. memory area.
-          }
-         procedure g_exception_reason_save(list : taasmoutput; const href : treference);virtual;
-         {#
-             This routine is used in exception management nodes. It should
-             save the exception reason constant. The
-             save should be done either to a temp (pointed to by href).
-             or on the stack (pushing the value on the stack).
-
-             The size of the value to save is OS_S32. The default version
-             saves the exception reason to a temp. memory area.
-          }
-         procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aint);virtual;
-         {#
-             This routine is used in exception management nodes. It should
-             load the exception reason to the FUNCTION_RETURN_REG. The saved value
-             should either be in the temp. area (pointed to by href , href should
-             *NOT* be freed) or on the stack (the value should be popped).
-
-             The size of the value to save is OS_S32. The default version
-             saves the exception reason to a temp. memory area.
-          }
-         procedure g_exception_reason_load(list : taasmoutput; const href : treference);virtual;
-
-          procedure g_maybe_testself(list : taasmoutput;reg:tregister);
-          procedure g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
-          {# This should emit the opcode to copy len bytes from the source
-             to destination.
-
-             It must be overriden for each new target processor.
-
-             @param(source Source reference of copy)
-             @param(dest Destination reference of copy)
-
-          }
-          procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint);virtual; abstract;
-          {# This should emit the opcode to copy len bytes from the an unaligned source
-             to destination.
-
-             It must be overriden for each new target processor.
-
-             @param(source Source reference of copy)
-             @param(dest Destination reference of copy)
-
-          }
-          procedure g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint);virtual;
-          {# This should emit the opcode to a shortrstring from the source
-             to destination.
-
-             @param(source Source reference of copy)
-             @param(dest Destination reference of copy)
-
-          }
-          procedure g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte);
-
-          procedure g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference);
-          procedure g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference);
-          procedure g_initialize(list : taasmoutput;t : tdef;const ref : treference);
-          procedure g_finalize(list : taasmoutput;t : tdef;const ref : treference);
-
-          {# Generates range checking code. It is to note
-             that this routine does not need to be overriden,
-             as it takes care of everything.
-
-             @param(p Node which contains the value to check)
-             @param(todef Type definition of node to range check)
-          }
-          procedure g_rangecheck(list: taasmoutput; const l:tlocation; fromdef,todef: tdef); virtual;
-
-          {# Generates overflow checking code for a node }
-          procedure g_overflowcheck(list: taasmoutput; const Loc:tlocation; def:tdef); virtual;abstract;
-          procedure g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual;
-
-          procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);virtual;
-          procedure g_releasevaluepara_openarray(list : taasmoutput;const l:tlocation);virtual;
-
-          {# Emits instructions when compilation is done in profile
-             mode (this is set as a command line option). The default
-             behavior does nothing, should be overriden as required.
-          }
-          procedure g_profilecode(list : taasmoutput);virtual;
-          {# Emits instruction for allocating @var(size) bytes at the stackpointer
-
-             @param(size Number of bytes to allocate)
-          }
-          procedure g_stackpointer_alloc(list : taasmoutput;size : longint);virtual; abstract;
-          {# Emits instruction for allocating the locals in entry
-             code of a routine. This is one of the first
-             routine called in @var(genentrycode).
-
-             @param(localsize Number of bytes to allocate as locals)
-          }
-          procedure g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);virtual; abstract;
-          {# Emits instructions for returning from a subroutine.
-             Should also restore the framepointer and stack.
-
-             @param(parasize  Number of bytes of parameters to deallocate from stack)
-          }
-          procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);virtual;abstract;
-          {# This routine is called when generating the code for the entry point
-             of a routine. It should save all registers which are not used in this
-             routine, and which should be declared as saved in the std_saved_registers
-             set.
-
-             This routine is mainly used when linking to code which is generated
-             by ABI-compliant compilers (like GCC), to make sure that the reserved
-             registers of that ABI are not clobbered.
-
-             @param(usedinproc Registers which are used in the code of this routine)
-          }
-          procedure g_save_standard_registers(list:Taasmoutput);virtual;
-          {# This routine is called when generating the code for the exit point
-             of a routine. It should restore all registers which were previously
-             saved in @var(g_save_standard_registers).
-
-             @param(usedinproc Registers which are used in the code of this routine)
-          }
-          procedure g_restore_standard_registers(list:Taasmoutput);virtual;
-          procedure g_intf_wrapper(list: TAAsmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract;
-          procedure g_adjust_self_value(list:taasmoutput;procdef: tprocdef;ioffset: aint);virtual;
-       end;
-
-{$ifndef cpu64bit}
-    {# @abstract(Abstract code generator for 64 Bit operations)
-       This class implements an abstract code generator class
-       for 64 Bit operations.
-    }
-    tcg64 = class
-        procedure a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);virtual;abstract;
-        procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);virtual;abstract;
-        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);virtual;abstract;
-        procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);virtual;abstract;
-        procedure a_load64_const_reg(list : taasmoutput;value : int64;reg : tregister64);virtual;abstract;
-        procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);virtual;abstract;
-        procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);virtual;abstract;
-        procedure a_load64_const_loc(list : taasmoutput;value : int64;const l : tlocation);virtual;abstract;
-        procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);virtual;abstract;
-
-        procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);virtual;abstract;
-        procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);virtual;abstract;
-        procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);virtual;abstract;
-        procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);virtual;abstract;
-        procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);virtual;abstract;
-        procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);virtual;abstract;
-
-        procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);virtual;abstract;
-        procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);virtual;abstract;
-        procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;size : tcgsize;regsrc : tregister64;const ref : treference);virtual;abstract;
-        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;regdst : tregister64);virtual;abstract;
-        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;const ref : treference);virtual;abstract;
-        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);virtual;abstract;
-        procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);virtual;abstract;
-        procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;size : tcgsize;const l : tlocation;reg64 : tregister64);virtual;abstract;
-        procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);virtual;
-        procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);virtual;
-        procedure a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual;
-        procedure a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual;
-
-        procedure a_param64_reg(list : taasmoutput;reg64 : tregister64;const loc : TCGPara);virtual;abstract;
-        procedure a_param64_const(list : taasmoutput;value : int64;const loc : TCGPara);virtual;abstract;
-        procedure a_param64_ref(list : taasmoutput;const r : treference;const loc : TCGPara);virtual;abstract;
-        procedure a_param64_loc(list : taasmoutput;const l : tlocation;const loc : TCGPara);virtual;abstract;
-
-        {
-             This routine tries to optimize the const_reg opcode, and should be
-             called at the start of a_op64_const_reg. It returns the actual opcode
-             to emit, and the constant value to emit. If this routine returns
-             TRUE, @var(no) instruction should be emitted (.eg : imul reg by 1 )
-
-             @param(op The opcode to emit, returns the opcode which must be emitted)
-             @param(a  The constant which should be emitted, returns the constant which must
-                    be emitted)
-             @param(reg The register to emit the opcode with, returns the register with
-                   which the opcode will be emitted)
-        }
-        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : int64; var reg: tregister64): boolean;virtual;abstract;
-
-
-        { override to catch 64bit rangechecks }
-        procedure g_rangecheck64(list: taasmoutput; const l:tlocation; fromdef,todef: tdef);virtual;abstract;
-    end;
-{$endif cpu64bit}
-
-    var
-       {# Main code generator class }
-       cg : tcg;
-{$ifndef cpu64bit}
-       {# Code generator class for all operations working with 64-Bit operands }
-       cg64 : tcg64;
-{$endif cpu64bit}
-
-
-implementation
-
-    uses
-       globals,options,systems,
-       verbose,defutil,paramgr,symsym,
-       tgobj,cutils,procinfo;
-
-    const
-      { Please leave this here, this module should NOT use
-        exprasmlist, the lists are always passed as arguments.
-        Declaring it as string here results in an error when compiling (PFV) }
-      exprasmlist = 'error';
-
-
-{*****************************************************************************
-                            basic functionallity
-******************************************************************************}
-
-    constructor tcg.create;
-      begin
-      end;
-
-
-{*****************************************************************************
-                                register allocation
-******************************************************************************}
-
-
-    procedure tcg.init_register_allocators;
-      begin
-        fillchar(rg,sizeof(rg),0);
-        add_reg_instruction_hook:=@add_reg_instruction;
-      end;
-
-
-    procedure tcg.done_register_allocators;
-      begin
-        { Safety }
-        fillchar(rg,sizeof(rg),0);
-        add_reg_instruction_hook:=nil;
-      end;
-
-    {$ifdef flowgraph}
-    procedure Tcg.init_flowgraph;
-
-    begin
-      aktflownode:=0;
-    end;
-
-    procedure Tcg.done_flowgraph;
-
-    begin
-    end;
-    {$endif}
-
-    function tcg.getintregister(list:Taasmoutput;size:Tcgsize):Tregister;
-      begin
-        if not assigned(rg[R_INTREGISTER]) then
-          internalerror(200312122);
-        result:=rg[R_INTREGISTER].getregister(list,cgsize2subreg(size));
-      end;
-
-
-    function tcg.getfpuregister(list:Taasmoutput;size:Tcgsize):Tregister;
-      begin
-        if not assigned(rg[R_FPUREGISTER]) then
-          internalerror(200312123);
-        result:=rg[R_FPUREGISTER].getregister(list,cgsize2subreg(size));
-      end;
-
-
-    function tcg.getmmregister(list:Taasmoutput;size:Tcgsize):Tregister;
-      begin
-        if not assigned(rg[R_MMREGISTER]) then
-          internalerror(2003121214);
-        result:=rg[R_MMREGISTER].getregister(list,cgsize2subreg(size));
-      end;
-
-
-    function tcg.getaddressregister(list:Taasmoutput):Tregister;
-      begin
-        if assigned(rg[R_ADDRESSREGISTER]) then
-          result:=rg[R_ADDRESSREGISTER].getregister(list,R_SUBWHOLE)
-        else
-          begin
-            if not assigned(rg[R_INTREGISTER]) then
-              internalerror(200312121);
-            result:=rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
-          end;
-      end;
-
-
-    function Tcg.makeregsize(list:Taasmoutput;reg:Tregister;size:Tcgsize):Tregister;
-      var
-        subreg:Tsubregister;
-      begin
-        subreg:=cgsize2subreg(size);
-        result:=reg;
-        setsubreg(result,subreg);
-        { notify RA }
-        if result<>reg then
-          list.concat(tai_regalloc.resize(result));
-      end;
-
-
-    procedure tcg.getcpuregister(list:Taasmoutput;r:Tregister);
-      begin
-        if not assigned(rg[getregtype(r)]) then
-          internalerror(200312125);
-        rg[getregtype(r)].getcpuregister(list,r);
-      end;
-
-
-    procedure tcg.ungetcpuregister(list:Taasmoutput;r:Tregister);
-      begin
-        if not assigned(rg[getregtype(r)]) then
-          internalerror(200312126);
-        rg[getregtype(r)].ungetcpuregister(list,r);
-      end;
-
-
-    procedure tcg.alloccpuregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);
-      begin
-        if assigned(rg[rt]) then
-          rg[rt].alloccpuregisters(list,r)
-        else
-          internalerror(200310092);
-      end;
-
-
-    procedure tcg.allocallcpuregisters(list:Taasmoutput);
-      begin
-        alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-{$ifndef i386}
-        alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
-{$ifdef cpumm}
-        alloccpuregisters(list,R_MMREGISTER,paramanager.get_volatile_registers_mm(pocall_default));
-{$endif cpumm}
-{$endif i386}
-      end;
-
-
-    procedure tcg.dealloccpuregisters(list:Taasmoutput;rt:Tregistertype;r:Tcpuregisterset);
-      begin
-        if assigned(rg[rt]) then
-          rg[rt].dealloccpuregisters(list,r)
-        else
-          internalerror(200310093);
-      end;
-
-
-    procedure tcg.deallocallcpuregisters(list:Taasmoutput);
-      begin
-        dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-{$ifndef i386}
-        dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
-{$ifdef cpumm}
-        dealloccpuregisters(list,R_MMREGISTER,paramanager.get_volatile_registers_mm(pocall_default));
-{$endif cpumm}
-{$endif i386}
-      end;
-
-
-    function tcg.uses_registers(rt:Tregistertype):boolean;
-      begin
-        if assigned(rg[rt]) then
-          result:=rg[rt].uses_registers
-        else
-          result:=false;
-      end;
-
-
-    procedure tcg.add_reg_instruction(instr:Tai;r:tregister);
-      var
-        rt : tregistertype;
-      begin
-        rt:=getregtype(r);
-        { Only add it when a register allocator is configured.
-          No IE can be generated, because the VMT is written
-          without a valid rg[] }
-        if assigned(rg[rt]) then
-          rg[rt].add_reg_instruction(instr,r);
-      end;
-
-
-    procedure tcg.add_move_instruction(instr:Taicpu);
-      var
-        rt : tregistertype;
-      begin
-        rt:=getregtype(instr.oper[O_MOV_SOURCE]^.reg);
-        if assigned(rg[rt]) then
-          rg[rt].add_move_instruction(instr)
-        else
-          internalerror(200310095);
-      end;
-
-
-    procedure tcg.do_register_allocation(list:Taasmoutput;headertai:tai);
-      var
-        rt : tregistertype;
-      begin
-        for rt:=R_FPUREGISTER to R_SPECIALREGISTER do
-          begin
-            if assigned(rg[rt]) then
-              rg[rt].do_register_allocation(list,headertai);
-          end;
-         { running the other register allocator passes could require addition int/addr. registers
-           when spilling so run int/addr register allocation at the end }
-         if assigned(rg[R_INTREGISTER]) then
-           rg[R_INTREGISTER].do_register_allocation(list,headertai);
-         if assigned(rg[R_ADDRESSREGISTER]) then
-           rg[R_ADDRESSREGISTER].do_register_allocation(list,headertai);
-      end;
-
-
-    procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister);
-      begin
-         list.concat(tai_regalloc.alloc(r,nil));
-      end;
-
-
-    procedure tcg.a_reg_dealloc(list : taasmoutput;r : tregister);
-      begin
-         list.concat(tai_regalloc.dealloc(r,nil));
-      end;
-
-
-    procedure tcg.a_reg_sync(list : taasmoutput;r : tregister);
-      var
-        instr : tai;
-      begin
-        instr:=tai_regalloc.sync(r);
-        list.concat(instr);
-        add_reg_instruction(instr,r);
-      end;
-
-
-    procedure tcg.a_label(list : taasmoutput;l : tasmlabel);
-      begin
-         list.concat(tai_label.create(l));
-      end;
-
-
-{*****************************************************************************
-          for better code generation these methods should be overridden
-******************************************************************************}
-
-    procedure tcg.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const cgpara : TCGPara);
-      var
-         ref : treference;
-      begin
-         cgpara.check_simple_location;
-         case cgpara.location^.loc of
-            LOC_REGISTER,LOC_CREGISTER:
-              a_load_reg_reg(list,size,cgpara.location^.size,r,cgpara.location^.register);
-            LOC_REFERENCE,LOC_CREFERENCE:
-              begin
-                 reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset);
-                 a_load_reg_ref(list,size,cgpara.location^.size,r,ref);
-              end
-            else
-              internalerror(2002071004);
-         end;
-      end;
-
-
-    procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const cgpara : TCGPara);
-      var
-         ref : treference;
-      begin
-         cgpara.check_simple_location;
-         case cgpara.location^.loc of
-            LOC_REGISTER,LOC_CREGISTER:
-              a_load_const_reg(list,cgpara.location^.size,a,cgpara.location^.register);
-            LOC_REFERENCE,LOC_CREFERENCE:
-              begin
-                 reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset);
-                 a_load_const_ref(list,cgpara.location^.size,a,ref);
-              end
-            else
-              internalerror(2002071004);
-         end;
-      end;
-
-
-    procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const cgpara : TCGPara);
-      var
-         ref : treference;
-      begin
-         cgpara.check_simple_location;
-         case cgpara.location^.loc of
-            LOC_REGISTER,LOC_CREGISTER:
-              a_load_ref_reg(list,size,cgpara.location^.size,r,cgpara.location^.register);
-            LOC_REFERENCE,LOC_CREFERENCE:
-              begin
-                 reference_reset(ref);
-                 ref.base:=cgpara.location^.reference.index;
-                 ref.offset:=cgpara.location^.reference.offset;
-                 { use concatcopy, because it can also be a float which fails when
-                   load_ref_ref is used }
-                 g_concatcopy(list,r,ref,tcgsize2size[size]);
-              end
-            else
-              internalerror(2002071004);
-         end;
-      end;
-
-
-    procedure tcg.a_param_loc(list : taasmoutput;const l:tlocation;const cgpara : TCGPara);
-      begin
-        case l.loc of
-          LOC_REGISTER,
-          LOC_CREGISTER :
-            a_param_reg(list,l.size,l.register,cgpara);
-          LOC_CONSTANT :
-            a_param_const(list,l.size,l.value,cgpara);
-          LOC_CREFERENCE,
-          LOC_REFERENCE :
-            a_param_ref(list,l.size,l.reference,cgpara);
-          else
-            internalerror(2002032211);
-        end;
-      end;
-
-
-    procedure tcg.a_paramaddr_ref(list : taasmoutput;const r : treference;const cgpara : TCGPara);
-      var
-         hr : tregister;
-      begin
-         cgpara.check_simple_location;
-         hr:=getaddressregister(list);
-         a_loadaddr_ref_reg(list,r,hr);
-         a_param_reg(list,OS_ADDR,hr,cgpara);
-      end;
-
-
-{****************************************************************************
-                       some generic implementations
-****************************************************************************}
-
-    procedure tcg.a_load_ref_ref(list : taasmoutput;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
-      var
-        tmpreg: tregister;
-      begin
-        { verify if we have the same reference }
-        if references_equal(sref,dref) then
-          exit;
-        tmpreg:=getintregister(list,tosize);
-        a_load_ref_reg(list,fromsize,tosize,sref,tmpreg);
-        a_load_reg_ref(list,tosize,tosize,tmpreg,dref);
-      end;
-
-
-    procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aint;const ref : treference);
-      var
-        tmpreg: tregister;
-      begin
-        tmpreg:=getintregister(list,size);
-        a_load_const_reg(list,size,a,tmpreg);
-        a_load_reg_ref(list,size,size,tmpreg,ref);
-      end;
-
-
-    procedure tcg.a_load_const_loc(list : taasmoutput;a : aint;const loc: tlocation);
-      begin
-        case loc.loc of
-          LOC_REFERENCE,LOC_CREFERENCE:
-            a_load_const_ref(list,loc.size,a,loc.reference);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load_const_reg(list,loc.size,a,loc.register);
-          else
-            internalerror(200203272);
-        end;
-      end;
-
-
-    procedure tcg.a_load_reg_loc(list : taasmoutput;fromsize : tcgsize;reg : tregister;const loc: tlocation);
-      begin
-        case loc.loc of
-          LOC_REFERENCE,LOC_CREFERENCE:
-            a_load_reg_ref(list,fromsize,loc.size,reg,loc.reference);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load_reg_reg(list,fromsize,loc.size,reg,loc.register);
-          else
-            internalerror(200203271);
-        end;
-      end;
-
-
-    procedure tcg.a_load_loc_reg(list : taasmoutput; tosize: tcgsize; const loc: tlocation; reg : tregister);
-      begin
-        case loc.loc of
-          LOC_REFERENCE,LOC_CREFERENCE:
-            a_load_ref_reg(list,loc.size,tosize,loc.reference,reg);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load_reg_reg(list,loc.size,tosize,loc.register,reg);
-          LOC_CONSTANT:
-            a_load_const_reg(list,tosize,loc.value,reg);
-          else
-            internalerror(200109092);
-        end;
-      end;
-
-
-    procedure tcg.a_load_loc_ref(list : taasmoutput;tosize: tcgsize; const loc: tlocation; const ref : treference);
-      begin
-        case loc.loc of
-          LOC_REFERENCE,LOC_CREFERENCE:
-            a_load_ref_ref(list,loc.size,tosize,loc.reference,ref);
-          LOC_REGISTER,LOC_CREGISTER:
-            a_load_reg_ref(list,loc.size,tosize,loc.register,ref);
-          LOC_CONSTANT:
-            a_load_const_ref(list,tosize,loc.value,ref);
-          else
-            internalerror(200109302);
-        end;
-      end;
-
-
-    function tcg.optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aint; var reg:tregister): boolean;
-      var
-        powerval : longint;
-      begin
-        optimize_op_const_reg := false;
-        case op of
-          { or with zero returns same result }
-          OP_OR : if a = 0 then optimize_op_const_reg := true;
-          { and with max returns same result }
-          OP_AND : if (a = high(a)) then optimize_op_const_reg := true;
-          { division by 1 returns result }
-          OP_DIV :
-            begin
-              if a = 1 then
-                optimize_op_const_reg := true
-              else if ispowerof2(int64(a), powerval) then
-                begin
-                  a := powerval;
-                  op:= OP_SHR;
-                end;
-              exit;
-            end;
-          OP_IDIV:
-            begin
-              if a = 1 then
-                optimize_op_const_reg := true
-              else if ispowerof2(int64(a), powerval) then
-                begin
-                  a := powerval;
-                  op:= OP_SAR;
-                end;
-               exit;
-            end;
-        OP_MUL,OP_IMUL:
-            begin
-               if a = 1 then
-                  optimize_op_const_reg := true
-               else if ispowerof2(int64(a), powerval) then
-                 begin
-                   a := powerval;
-                   op:= OP_SHL;
-                 end;
-               exit;
-            end;
-        OP_SAR,OP_SHL,OP_SHR:
-           begin
-              if a = 0 then
-                 optimize_op_const_reg := true;
-              exit;
-           end;
-        end;
-      end;
-
-
-    procedure tcg.a_loadfpu_loc_reg(list: taasmoutput; const loc: tlocation; const reg: tregister);
-      begin
-        case loc.loc of
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_loadfpu_ref_reg(list,loc.size,loc.reference,reg);
-          LOC_FPUREGISTER, LOC_CFPUREGISTER:
-            a_loadfpu_reg_reg(list,loc.size,loc.register,reg);
-          else
-            internalerror(200203301);
-        end;
-      end;
-
-
-    procedure tcg.a_loadfpu_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation);
-      begin
-        case loc.loc of
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_loadfpu_reg_ref(list,size,reg,loc.reference);
-          LOC_FPUREGISTER, LOC_CFPUREGISTER:
-            a_loadfpu_reg_reg(list,size,reg,loc.register);
-          else
-            internalerror(48991);
-         end;
-      end;
-
-
-    procedure tcg.a_paramfpu_reg(list : taasmoutput;size : tcgsize;const r : tregister;const cgpara : TCGPara);
-      var
-         ref : treference;
-      begin
-         case cgpara.location^.loc of
-            LOC_FPUREGISTER,LOC_CFPUREGISTER:
-              begin
-                cgpara.check_simple_location;
-                a_loadfpu_reg_reg(list,size,r,cgpara.location^.register);
-              end;
-            LOC_REFERENCE,LOC_CREFERENCE:
-              begin
-                cgpara.check_simple_location;
-                reference_reset_base(ref,cgpara.location^.reference.index,cgpara.location^.reference.offset);
-                a_loadfpu_reg_ref(list,size,r,ref);
-              end;
-            LOC_REGISTER,LOC_CREGISTER:
-              begin
-                { paramfpu_ref does the check_simpe_location check here if necessary }
-                tg.GetTemp(list,TCGSize2Size[size],tt_normal,ref);
-                a_loadfpu_reg_ref(list,size,r,ref);
-                a_paramfpu_ref(list,size,ref,cgpara);
-                tg.Ungettemp(list,ref);
-              end;
-            else
-              internalerror(2002071004);
-         end;
-      end;
-
-
-    procedure tcg.a_paramfpu_ref(list : taasmoutput;size : tcgsize;const ref : treference;const cgpara : TCGPara);
-      var
-         href : treference;
-      begin
-         cgpara.check_simple_location;
-         case cgpara.location^.loc of
-          LOC_FPUREGISTER,LOC_CFPUREGISTER:
-            a_loadfpu_ref_reg(list,size,ref,cgpara.location^.register);
-          LOC_REFERENCE,LOC_CREFERENCE:
-            begin
-              reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset);
-              { concatcopy should choose the best way to copy the data }
-              g_concatcopy(list,ref,href,tcgsize2size[size]);
-            end;
-          else
-            internalerror(200402201);
-        end;
-      end;
-
-
-    procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; const ref: TReference);
-      var
-        tmpreg : tregister;
-      begin
-        tmpreg:=getintregister(list,size);
-        a_load_ref_reg(list,size,size,ref,tmpreg);
-        a_op_const_reg(list,op,size,a,tmpreg);
-        a_load_reg_ref(list,size,size,tmpreg,ref);
-      end;
-
-
-    procedure tcg.a_op_const_loc(list : taasmoutput; Op: TOpCG; a: aint; const loc: tlocation);
-      begin
-        case loc.loc of
-          LOC_REGISTER, LOC_CREGISTER:
-            a_op_const_reg(list,op,loc.size,a,loc.register);
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_op_const_ref(list,op,loc.size,a,loc.reference);
-          else
-            internalerror(200109061);
-        end;
-      end;
-
-
-    procedure tcg.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister;  const ref: TReference);
-      var
-        tmpreg : tregister;
-      begin
-        tmpreg:=getintregister(list,size);
-        a_load_ref_reg(list,size,size,ref,tmpreg);
-        a_op_reg_reg(list,op,size,reg,tmpreg);
-        a_load_reg_ref(list,size,size,tmpreg,ref);
-      end;
-
-
-    procedure tcg.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
-
-      var
-        tmpreg: tregister;
-
-      begin
-        case op of
-          OP_NOT,OP_NEG:
-            { handle it as "load ref,reg; op reg" }
-            begin
-              a_load_ref_reg(list,size,size,ref,reg);
-              a_op_reg_reg(list,op,size,reg,reg);
-            end;
-          else
-            begin
-              tmpreg:=getintregister(list,size);
-              a_load_ref_reg(list,size,size,ref,tmpreg);
-              a_op_reg_reg(list,op,size,tmpreg,reg);
-            end;
-        end;
-      end;
-
-
-    procedure tcg.a_op_reg_loc(list : taasmoutput; Op: TOpCG; reg: tregister; const loc: tlocation);
-
-      begin
-        case loc.loc of
-          LOC_REGISTER, LOC_CREGISTER:
-            a_op_reg_reg(list,op,loc.size,reg,loc.register);
-          LOC_REFERENCE, LOC_CREFERENCE:
-            a_op_reg_ref(list,op,loc.size,reg,loc.reference);
-          else
-            internalerror(200109061);
-        end;
-      end;
-
-
-    procedure tcg.a_op_ref_loc(list : taasmoutput; Op: TOpCG; const ref: TReference; const loc: tlocation);
-
-      var
-        tmpreg: tregister;
-
-      begin
-        case loc.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_op_ref_reg(list,op,loc.size,ref,loc.register);
-          LOC_REFERENCE,LOC_CREFERENCE:
-            begin
-              tmpreg:=getintregister(list,loc.size);
-              a_load_ref_reg(list,loc.size,loc.size,ref,tmpreg);
-              a_op_reg_ref(list,op,loc.size,tmpreg,loc.reference);
-            end;
-          else
-            internalerror(200109061);
-        end;
-      end;
-
-    procedure Tcg.a_op_const_reg_reg(list:Taasmoutput;op:Topcg;size:Tcgsize;
-                                     a:aint;src,dst:Tregister);
-
-    begin
-      a_load_reg_reg(list,size,size,src,dst);
-      a_op_const_reg(list,op,size,a,dst);
-    end;
-
-    procedure tcg.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
-        size: tcgsize; src1, src2, dst: tregister);
-      var
-        tmpreg: tregister;
-      begin
-        if (dst<>src1) then
-          begin
-            a_load_reg_reg(list,size,size,src2,dst);
-            a_op_reg_reg(list,op,size,src1,dst);
-          end
-        else
-          begin
-            tmpreg:=getintregister(list,size);
-            a_load_reg_reg(list,size,size,src2,tmpreg);
-            a_op_reg_reg(list,op,size,src1,tmpreg);
-            a_load_reg_reg(list,size,size,tmpreg,dst);
-          end;
-      end;
-
-
-    procedure tcg.a_op_const_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);
-      begin
-        a_op_const_reg_reg(list,op,size,a,src,dst);
-        ovloc.loc:=LOC_VOID;
-      end;
-
-
-    procedure tcg.a_op_reg_reg_reg_checkoverflow(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);
-      begin
-        a_op_reg_reg_reg(list,op,size,src1,src2,dst);
-        ovloc.loc:=LOC_VOID;
-      end;
-
-
-    procedure tcg.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;const ref : treference;
-     l : tasmlabel);
-
-      var
-        tmpreg: tregister;
-      begin
-        tmpreg:=getintregister(list,size);
-        a_load_ref_reg(list,size,size,ref,tmpreg);
-        a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
-      end;
-
-
-    procedure tcg.a_cmp_const_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;const loc : tlocation;
-      l : tasmlabel);
-
-      begin
-        case loc.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l);
-          LOC_REFERENCE,LOC_CREFERENCE:
-            a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l);
-          else
-            internalerror(200109061);
-        end;
-      end;
-
-
-    procedure tcg.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel);
-      var
-        tmpreg: tregister;
-      begin
-        tmpreg:=getintregister(list,size);
-        a_load_ref_reg(list,size,size,ref,tmpreg);
-        a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l);
-      end;
-
-
-    procedure tcg.a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; reg : tregister; const ref: treference; l : tasmlabel);
-      var
-        tmpreg: tregister;
-      begin
-        tmpreg:=getintregister(list,size);
-        a_load_ref_reg(list,size,size,ref,tmpreg);
-        a_cmp_reg_reg_label(list,size,cmp_op,reg,tmpreg,l);
-      end;
-
-
-    procedure tcg.a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
-      begin
-        case loc.loc of
-          LOC_REGISTER,
-          LOC_CREGISTER:
-            a_cmp_reg_reg_label(list,size,cmp_op,loc.register,reg,l);
-          LOC_REFERENCE,
-          LOC_CREFERENCE :
-            a_cmp_ref_reg_label(list,size,cmp_op,loc.reference,reg,l);
-          LOC_CONSTANT:
-            a_cmp_const_reg_label(list,size,cmp_op,loc.value,reg,l);
-          else
-            internalerror(200203231);
-        end;
-      end;
-
-
-    procedure tcg.a_cmp_ref_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation;
-      l : tasmlabel);
-      var
-        tmpreg: tregister;
-      begin
-        case loc.loc of
-          LOC_REGISTER,LOC_CREGISTER:
-            a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l);
-          LOC_REFERENCE,LOC_CREFERENCE:
-            begin
-              tmpreg:=getintregister(list,size);
-              a_load_ref_reg(list,size,size,loc.reference,tmpreg);
-              a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l);
-            end
-          else
-            internalerror(200109061);
-        end;
-      end;
-
-
-    procedure tcg.a_loadmm_loc_reg(list: taasmoutput; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle);
-      begin
-        case loc.loc of
-          LOC_MMREGISTER,LOC_CMMREGISTER:
-            a_loadmm_reg_reg(list,loc.size,size,loc.register,reg,shuffle);
-          LOC_REFERENCE,LOC_CREFERENCE:
-            a_loadmm_ref_reg(list,loc.size,size,loc.reference,reg,shuffle);
-          else
-            internalerror(200310121);
-        end;
-      end;
-
-
-    procedure tcg.a_loadmm_reg_loc(list: taasmoutput; size: tcgsize; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle);
-      begin
-        case loc.loc of
-          LOC_MMREGISTER,LOC_CMMREGISTER:
-            a_loadmm_reg_reg(list,size,loc.size,reg,loc.register,shuffle);
-          LOC_REFERENCE,LOC_CREFERENCE:
-            a_loadmm_reg_ref(list,size,loc.size,reg,loc.reference,shuffle);
-          else
-            internalerror(200310122);
-        end;
-      end;
-
-
-    procedure tcg.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle);
-      var
-        href : treference;
-      begin
-         cgpara.check_simple_location;
-         case cgpara.location^.loc of
-          LOC_MMREGISTER,LOC_CMMREGISTER:
-            a_loadmm_reg_reg(list,size,cgpara.location^.size,reg,cgpara.location^.register,shuffle);
-          LOC_REFERENCE,LOC_CREFERENCE:
-            begin
-              reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset);
-              a_loadmm_reg_ref(list,size,cgpara.location^.size,reg,href,shuffle);
-            end
-          else
-            internalerror(200310123);
-        end;
-      end;
-
-
-    procedure tcg.a_parammm_ref(list: taasmoutput; size: tcgsize;const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle);
-      var
-         hr : tregister;
-         hs : tmmshuffle;
-      begin
-         cgpara.check_simple_location;
-         hr:=getmmregister(list,cgpara.location^.size);
-         a_loadmm_ref_reg(list,size,cgpara.location^.size,ref,hr,shuffle);
-         if realshuffle(shuffle) then
-           begin
-             hs:=shuffle^;
-             removeshuffles(hs);
-             a_parammm_reg(list,cgpara.location^.size,hr,cgpara,@hs);
-           end
-         else
-           a_parammm_reg(list,cgpara.location^.size,hr,cgpara,shuffle);
-      end;
-
-
-    procedure tcg.a_parammm_loc(list: taasmoutput;const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle);
-      begin
-        case loc.loc of
-          LOC_MMREGISTER,LOC_CMMREGISTER:
-            a_parammm_reg(list,loc.size,loc.register,cgpara,shuffle);
-          LOC_REFERENCE,LOC_CREFERENCE:
-            a_parammm_ref(list,loc.size,loc.reference,cgpara,shuffle);
-          else
-            internalerror(200310123);
-        end;
-      end;
-
-
-    procedure tcg.a_opmm_ref_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle);
-      var
-         hr : tregister;
-         hs : tmmshuffle;
-      begin
-         hr:=getmmregister(list,size);
-         a_loadmm_ref_reg(list,size,size,ref,hr,shuffle);
-         if realshuffle(shuffle) then
-           begin
-             hs:=shuffle^;
-             removeshuffles(hs);
-             a_opmm_reg_reg(list,op,size,hr,reg,@hs);
-           end
-         else
-           a_opmm_reg_reg(list,op,size,hr,reg,shuffle);
-      end;
-
-
-    procedure tcg.a_opmm_reg_ref(list: taasmoutput; Op: TOpCG; size : tcgsize;reg: tregister; const ref: treference; shuffle : pmmshuffle);
-      var
-         hr : tregister;
-         hs : tmmshuffle;
-      begin
-         hr:=getmmregister(list,size);
-         a_loadmm_ref_reg(list,size,size,ref,hr,shuffle);
-         if realshuffle(shuffle) then
-           begin
-             hs:=shuffle^;
-             removeshuffles(hs);
-             a_opmm_reg_reg(list,op,size,reg,hr,@hs);
-             a_loadmm_reg_ref(list,size,size,hr,ref,@hs);
-           end
-         else
-           begin
-             a_opmm_reg_reg(list,op,size,reg,hr,shuffle);
-             a_loadmm_reg_ref(list,size,size,hr,ref,shuffle);
-           end;
-      end;
-
-
-    procedure tcg.a_opmm_loc_reg(list: taasmoutput; Op: TOpCG; size : tcgsize;const loc: tlocation; reg: tregister;shuffle : pmmshuffle);
-      begin
-        case loc.loc of
-          LOC_CMMREGISTER,LOC_MMREGISTER:
-            a_opmm_reg_reg(list,op,size,loc.register,reg,shuffle);
-          LOC_CREFERENCE,LOC_REFERENCE:
-            a_opmm_ref_reg(list,op,size,loc.reference,reg,shuffle);
-          else
-            internalerror(200312232);
-        end;
-      end;
-
-
-    procedure tcg.g_concatcopy_unaligned(list : taasmoutput;const source,dest : treference;len : aint);
-      begin
-        g_concatcopy(list,source,dest,len);
-      end;
-
-
-    procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte);
-      var
-        cgpara1,cgpara2,cgpara3 : TCGPara;
-      begin
-        cgpara1.init;
-        cgpara2.init;
-        cgpara3.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
-        paramanager.getintparaloc(pocall_default,3,cgpara3);
-        paramanager.allocparaloc(list,cgpara3);
-        a_paramaddr_ref(list,dest,cgpara3);
-        paramanager.allocparaloc(list,cgpara2);
-        a_paramaddr_ref(list,source,cgpara2);
-        paramanager.allocparaloc(list,cgpara1);
-        a_param_const(list,OS_INT,len,cgpara1);
-        paramanager.freeparaloc(list,cgpara3);
-        paramanager.freeparaloc(list,cgpara2);
-        paramanager.freeparaloc(list,cgpara1);
-        allocallcpuregisters(list);
-        a_call_name(list,'FPC_SHORTSTR_ASSIGN');
-        deallocallcpuregisters(list);
-        cgpara3.done;
-        cgpara2.done;
-        cgpara1.done;
-      end;
-
-
-    procedure tcg.g_incrrefcount(list : taasmoutput;t: tdef; const ref: treference);
-      var
-        href : treference;
-        incrfunc : string;
-        cgpara1,cgpara2 : TCGPara;
-      begin
-         cgpara1.init;
-         cgpara2.init;
-         paramanager.getintparaloc(pocall_default,1,cgpara1);
-         paramanager.getintparaloc(pocall_default,2,cgpara2);
-         if is_interfacecom(t) then
-          incrfunc:='FPC_INTF_INCR_REF'
-         else if is_ansistring(t) then
-       {$ifdef ansistring_bits}
-           begin
-             case Tstringdef(t).string_typ of
-               st_ansistring16:
-                 incrfunc:='FPC_ANSISTR16_INCR_REF';
-               st_ansistring32:
-                 incrfunc:='FPC_ANSISTR32_INCR_REF';
-               st_ansistring64:
-                 incrfunc:='FPC_ANSISTR64_INCR_REF';
-             end;
-           end
-       {$else}
-            incrfunc:='FPC_ANSISTR_INCR_REF'
-       {$endif}
-         else if is_widestring(t) then
-          incrfunc:='FPC_WIDESTR_INCR_REF'
-         else if is_dynamic_array(t) then
-          incrfunc:='FPC_DYNARRAY_INCR_REF'
-         else
-          incrfunc:='';
-         { call the special incr function or the generic addref }
-         if incrfunc<>'' then
-          begin
-            paramanager.allocparaloc(list,cgpara1);
-            { these functions get the pointer by value }
-            a_param_ref(list,OS_ADDR,ref,cgpara1);
-            paramanager.freeparaloc(list,cgpara1);
-            allocallcpuregisters(list);
-            a_call_name(list,incrfunc);
-            deallocallcpuregisters(list);
-          end
-         else
-          begin
-            reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-            paramanager.allocparaloc(list,cgpara2);
-            a_paramaddr_ref(list,href,cgpara2);
-            paramanager.allocparaloc(list,cgpara1);
-            a_paramaddr_ref(list,ref,cgpara1);
-            paramanager.freeparaloc(list,cgpara1);
-            paramanager.freeparaloc(list,cgpara2);
-            allocallcpuregisters(list);
-            a_call_name(list,'FPC_ADDREF');
-            deallocallcpuregisters(list);
-          end;
-         cgpara2.done;
-         cgpara1.done;
-      end;
-
-
-    procedure tcg.g_decrrefcount(list : taasmoutput;t: tdef; const ref: treference);
-      var
-        href : treference;
-        decrfunc : string;
-        needrtti : boolean;
-        cgpara1,cgpara2 : TCGPara;
-      begin
-        cgpara1.init;
-        cgpara2.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
-        needrtti:=false;
-        if is_interfacecom(t) then
-          decrfunc:='FPC_INTF_DECR_REF'
-        else if is_ansistring(t) then
-       {$ifdef ansistring_bits}
-           begin
-             case Tstringdef(t).string_typ of
-               st_ansistring16:
-                 decrfunc:='FPC_ANSISTR16_DECR_REF';
-               st_ansistring32:
-                 decrfunc:='FPC_ANSISTR32_DECR_REF';
-               st_ansistring64:
-                 decrfunc:='FPC_ANSISTR64_DECR_REF';
-             end;
-           end
-       {$else}
-            decrfunc:='FPC_ANSISTR_DECR_REF'
-       {$endif}
-         else if is_widestring(t) then
-          decrfunc:='FPC_WIDESTR_DECR_REF'
-         else if is_dynamic_array(t) then
-          begin
-            decrfunc:='FPC_DYNARRAY_DECR_REF';
-            needrtti:=true;
-          end
-         else
-          decrfunc:='';
-         { call the special decr function or the generic decref }
-         if decrfunc<>'' then
-          begin
-            if needrtti then
-             begin
-               reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-               paramanager.allocparaloc(list,cgpara2);
-               a_paramaddr_ref(list,href,cgpara2);
-             end;
-            paramanager.allocparaloc(list,cgpara1);
-            a_paramaddr_ref(list,ref,cgpara1);
-            paramanager.freeparaloc(list,cgpara1);
-            if needrtti then
-              paramanager.freeparaloc(list,cgpara2);
-            allocallcpuregisters(list);
-            a_call_name(list,decrfunc);
-            deallocallcpuregisters(list);
-          end
-         else
-          begin
-            reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-            paramanager.allocparaloc(list,cgpara2);
-            a_paramaddr_ref(list,href,cgpara2);
-            paramanager.allocparaloc(list,cgpara1);
-            a_paramaddr_ref(list,ref,cgpara1);
-            paramanager.freeparaloc(list,cgpara1);
-            paramanager.freeparaloc(list,cgpara2);
-            allocallcpuregisters(list);
-            a_call_name(list,'FPC_DECREF');
-            deallocallcpuregisters(list);
-         end;
-        cgpara2.done;
-        cgpara1.done;
-      end;
-
-
-    procedure tcg.g_initialize(list : taasmoutput;t : tdef;const ref : treference);
-      var
-         href : treference;
-         cgpara1,cgpara2 : TCGPara;
-      begin
-        cgpara1.init;
-        cgpara2.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
-         if is_ansistring(t) or
-            is_widestring(t) or
-            is_interfacecom(t) or
-            is_dynamic_array(t) then
-           a_load_const_ref(list,OS_ADDR,0,ref)
-         else
-           begin
-              reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-              paramanager.allocparaloc(list,cgpara2);
-              a_paramaddr_ref(list,href,cgpara2);
-              paramanager.allocparaloc(list,cgpara1);
-              a_paramaddr_ref(list,ref,cgpara1);
-              paramanager.freeparaloc(list,cgpara1);
-              paramanager.freeparaloc(list,cgpara2);
-              allocallcpuregisters(list);
-              a_call_name(list,'FPC_INITIALIZE');
-              deallocallcpuregisters(list);
-           end;
-        cgpara1.done;
-        cgpara2.done;
-      end;
-
-
-    procedure tcg.g_finalize(list : taasmoutput;t : tdef;const ref : treference);
-      var
-         href : treference;
-         cgpara1,cgpara2 : TCGPara;
-      begin
-        cgpara1.init;
-        cgpara2.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
-         if is_ansistring(t) or
-            is_widestring(t) or
-            is_interfacecom(t) then
-           begin
-             g_decrrefcount(list,t,ref);
-             a_load_const_ref(list,OS_ADDR,0,ref);
-           end
-         else
-           begin
-              reference_reset_symbol(href,tstoreddef(t).get_rtti_label(initrtti),0);
-              paramanager.allocparaloc(list,cgpara2);
-              a_paramaddr_ref(list,href,cgpara2);
-              paramanager.allocparaloc(list,cgpara1);
-              a_paramaddr_ref(list,ref,cgpara1);
-              paramanager.freeparaloc(list,cgpara1);
-              paramanager.freeparaloc(list,cgpara2);
-              allocallcpuregisters(list);
-              a_call_name(list,'FPC_FINALIZE');
-              deallocallcpuregisters(list);
-           end;
-        cgpara1.done;
-        cgpara2.done;
-      end;
-
-
-    procedure tcg.g_rangecheck(list: taasmoutput; const l:tlocation;fromdef,todef: tdef);
-    { generate range checking code for the value at location p. The type     }
-    { type used is checked against todefs ranges. fromdef (p.resulttype.def) }
-    { is the original type used at that location. When both defs are equal   }
-    { the check is also insert (needed for succ,pref,inc,dec)                }
-      const
-        aintmax=high(aint);
-      var
-        neglabel : tasmlabel;
-        hreg : tregister;
-        lto,hto,
-        lfrom,hfrom : TConstExprInt;
-        from_signed: boolean;
-      begin
-        { range checking on and range checkable value? }
-        if not(cs_check_range in aktlocalswitches) or
-           not(fromdef.deftype in [orddef,enumdef,arraydef]) then
-          exit;
-{$ifndef cpu64bit}
-        { handle 64bit rangechecks separate for 32bit processors }
-        if is_64bit(fromdef) or is_64bit(todef) then
-          begin
-             cg64.g_rangecheck64(list,l,fromdef,todef);
-             exit;
-          end;
-{$endif cpu64bit}
-        { only check when assigning to scalar, subranges are different, }
-        { when todef=fromdef then the check is always generated         }
-        getrange(fromdef,lfrom,hfrom);
-        getrange(todef,lto,hto);
-        from_signed := is_signed(fromdef);
-        { no range check if from and to are equal and are both longint/dword }
-        { (if we have a 32bit processor) or int64/qword, since such          }
-        { operations can at most cause overflows (JM)                        }
-        { Note that these checks are mostly processor independent, they only }
-        { have to be changed once we introduce 64bit subrange types          }
-{$ifdef cpu64bit}
-        if (fromdef = todef) and
-           (fromdef.deftype=orddef) and
-           (((((torddef(fromdef).typ = s64bit) and
-               (lfrom = low(int64)) and
-               (hfrom = high(int64))) or
-              ((torddef(fromdef).typ = u64bit) and
-               (lfrom = low(qword)) and
-               (hfrom = high(qword)))))) then
-          exit;
-{$else cpu64bit}
-        if (fromdef = todef) and
-           (fromdef.deftype=orddef) and
-           (((((torddef(fromdef).typ = s32bit) and
-               (lfrom = low(longint)) and
-               (hfrom = high(longint))) or
-              ((torddef(fromdef).typ = u32bit) and
-               (lfrom = low(cardinal)) and
-               (hfrom = high(cardinal)))))) then
-          exit;
-{$endif cpu64bit}
-
-        { if the from-range falls completely in the to-range, no check }
-        { is necessary. Don't do this conversion for the largest unsigned type }
-        if (todef<>fromdef) and
-           (from_signed or (hfrom>=0)) and
-           (lto<=lfrom) and (hto>=hfrom) then
-          exit;
-
-        { generate the rangecheck code for the def where we are going to }
-        { store the result                                               }
-
-        { use the trick that                                                 }
-        { a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
-
-        { To be able to do that, we have to make sure however that either    }
-        { fromdef and todef are both signed or unsigned, or that we leave    }
-        { the parts < 0 and > maxlongint out                                 }
-
-        { is_signed now also works for arrays (it checks the rangetype) (JM) }
-        if from_signed xor is_signed(todef) then
-          begin
-             if from_signed then
-               { from is signed, to is unsigned }
-               begin
-                 { if high(from) < 0 -> always range error }
-                 if (hfrom < 0) or
-                    { if low(to) > maxlongint also range error }
-                    (lto > aintmax) then
-                   begin
-                     a_call_name(list,'FPC_RANGEERROR');
-                     exit
-                   end;
-                 { from is signed and to is unsigned -> when looking at to }
-                 { as an signed value, it must be < maxaint (otherwise     }
-                 { it will become negative, which is invalid since "to" is unsigned) }
-                 if hto > aintmax then
-                   hto := aintmax;
-               end
-             else
-               { from is unsigned, to is signed }
-               begin
-                 if (lfrom > aintmax) or
-                    (hto < 0) then
-                   begin
-                     a_call_name(list,'FPC_RANGEERROR');
-                     exit
-                   end;
-                 { from is unsigned and to is signed -> when looking at to }
-                 { as an unsigned value, it must be >= 0 (since negative   }
-                 { values are the same as values > maxlongint)             }
-                 if lto < 0 then
-                   lto := 0;
-               end;
-          end;
-        hreg:=getintregister(list,OS_INT);
-        a_load_loc_reg(list,OS_INT,l,hreg);
-        a_op_const_reg(list,OP_SUB,OS_INT,aint(lto),hreg);
-        objectlibrary.getjumplabel(neglabel);
-        {
-        if from_signed then
-          a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel)
-        else
-        }
-{$ifdef cpu64bit}
-        if qword(hto-lto)>qword(aintmax) then
-          a_cmp_const_reg_label(list,OS_INT,OC_BE,aintmax,hreg,neglabel)
-        else
-{$endif cpu64bit}
-          a_cmp_const_reg_label(list,OS_INT,OC_BE,aint(hto-lto),hreg,neglabel);
-        a_call_name(list,'FPC_RANGEERROR');
-        a_label(list,neglabel);
-      end;
-
-
-    procedure tcg.g_overflowCheck_loc(List:TAasmOutput;const Loc:TLocation;def:TDef;ovloc : tlocation);
-      begin
-        g_overflowCheck(list,loc,def);
-      end;
-
-
-    procedure tcg.g_flags2ref(list: taasmoutput; size: TCgSize; const f: tresflags; const ref:TReference);
-
-      var
-        tmpreg : tregister;
-      begin
-        tmpreg:=getintregister(list,size);
-        g_flags2reg(list,size,f,tmpreg);
-        a_load_reg_ref(list,size,size,tmpreg,ref);
-      end;
-
-
-    procedure tcg.g_maybe_testself(list : taasmoutput;reg:tregister);
-      var
-        OKLabel : tasmlabel;
-        cgpara1 : TCGPara;
-      begin
-        if (cs_check_object in aktlocalswitches) or
-           (cs_check_range in aktlocalswitches) then
-         begin
-           objectlibrary.getjumplabel(oklabel);
-           a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
-           cgpara1.init;
-           paramanager.getintparaloc(pocall_default,1,cgpara1);
-           paramanager.allocparaloc(list,cgpara1);
-           a_param_const(list,OS_INT,210,cgpara1);
-           paramanager.freeparaloc(list,cgpara1);
-           a_call_name(list,'FPC_HANDLEERROR');
-           a_label(list,oklabel);
-           cgpara1.done;
-         end;
-      end;
-
-
-    procedure tcg.g_maybe_testvmt(list : taasmoutput;reg:tregister;objdef:tobjectdef);
-      var
-        hrefvmt : treference;
-        cgpara1,cgpara2 : TCGPara;
-      begin
-        cgpara1.init;
-        cgpara2.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
-        if (cs_check_object in aktlocalswitches) then
-         begin
-           reference_reset_symbol(hrefvmt,objectlibrary.newasmsymbol(objdef.vmt_mangledname,AB_EXTERNAL,AT_DATA),0);
-           paramanager.allocparaloc(list,cgpara2);
-           a_paramaddr_ref(list,hrefvmt,cgpara2);
-           paramanager.allocparaloc(list,cgpara1);
-           a_param_reg(list,OS_ADDR,reg,cgpara1);
-           paramanager.freeparaloc(list,cgpara1);
-           paramanager.freeparaloc(list,cgpara2);
-           allocallcpuregisters(list);
-           a_call_name(list,'FPC_CHECK_OBJECT_EXT');
-           deallocallcpuregisters(list);
-         end
-        else
-         if (cs_check_range in aktlocalswitches) then
-          begin
-            paramanager.allocparaloc(list,cgpara1);
-            a_param_reg(list,OS_ADDR,reg,cgpara1);
-            paramanager.freeparaloc(list,cgpara1);
-            allocallcpuregisters(list);
-            a_call_name(list,'FPC_CHECK_OBJECT');
-            deallocallcpuregisters(list);
-          end;
-        cgpara1.done;
-        cgpara2.done;
-      end;
-
-
-{*****************************************************************************
-                            Entry/Exit Code Functions
-*****************************************************************************}
-
-    procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;const lenloc:tlocation;elesize:aint;destreg:tregister);
-      var
-        sizereg,sourcereg,lenreg : tregister;
-        cgpara1,cgpara2,cgpara3 : TCGPara;
-      begin
-        { because some abis don't support dynamic stack allocation properly
-          open array value parameters are copied onto the heap
-        }
-
-        { calculate necessary memory }
-
-        { read/write operations on one register make the life of the register allocator hard }
-        if not(lenloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-          begin
-            lenreg:=getintregister(list,OS_INT);
-            a_load_loc_reg(list,OS_INT,lenloc,lenreg);
-          end
-        else
-          lenreg:=lenloc.register;
-
-        sizereg:=getintregister(list,OS_INT);
-        a_op_const_reg_reg(list,OP_ADD,OS_INT,1,lenreg,sizereg);
-        a_op_const_reg(list,OP_IMUL,OS_INT,elesize,sizereg);
-        { load source }
-        sourcereg:=getaddressregister(list);
-        a_loadaddr_ref_reg(list,ref,sourcereg);
-
-        { do getmem call }
-        cgpara1.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.allocparaloc(list,cgpara1);
-        a_param_reg(list,OS_INT,sizereg,cgpara1);
-        paramanager.freeparaloc(list,cgpara1);
-        allocallcpuregisters(list);
-        a_call_name(list,'FPC_GETMEM');
-        deallocallcpuregisters(list);
-        cgpara1.done;
-        { return the new address }
-        a_load_reg_reg(list,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,destreg);
-
-        { do move call }
-        cgpara1.init;
-        cgpara2.init;
-        cgpara3.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        paramanager.getintparaloc(pocall_default,2,cgpara2);
-        paramanager.getintparaloc(pocall_default,3,cgpara3);
-        { load size }
-        paramanager.allocparaloc(list,cgpara3);
-        a_param_reg(list,OS_INT,sizereg,cgpara3);
-        { load destination }
-        paramanager.allocparaloc(list,cgpara2);
-        a_param_reg(list,OS_ADDR,destreg,cgpara2);
-        { load source }
-        paramanager.allocparaloc(list,cgpara1);
-        a_param_reg(list,OS_ADDR,sourcereg,cgpara1);
-        paramanager.freeparaloc(list,cgpara3);
-        paramanager.freeparaloc(list,cgpara2);
-        paramanager.freeparaloc(list,cgpara1);
-        allocallcpuregisters(list);
-        a_call_name(list,'FPC_MOVE');
-        deallocallcpuregisters(list);
-        cgpara3.done;
-        cgpara2.done;
-        cgpara1.done;
-      end;
-
-
-    procedure tcg.g_releasevaluepara_openarray(list : taasmoutput;const l:tlocation);
-      var
-        cgpara1 : TCGPara;
-      begin
-        { do move call }
-        cgpara1.init;
-        paramanager.getintparaloc(pocall_default,1,cgpara1);
-        { load source }
-        paramanager.allocparaloc(list,cgpara1);
-        a_param_loc(list,l,cgpara1);
-        paramanager.freeparaloc(list,cgpara1);
-        allocallcpuregisters(list);
-        a_call_name(list,'FPC_FREEMEM');
-        deallocallcpuregisters(list);
-        cgpara1.done;
-      end;
-
-
-    procedure tcg.g_save_standard_registers(list:Taasmoutput);
-      var
-        href : treference;
-        size : longint;
-        r : integer;
-      begin
-        { Get temp }
-        size:=0;
-        for r:=low(saved_standard_registers) to high(saved_standard_registers) do
-          if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
-            inc(size,sizeof(aint));
-        if size>0 then
-          begin
-            tg.GetTemp(list,size,tt_noreuse,current_procinfo.save_regs_ref);
-            { Copy registers to temp }
-            href:=current_procinfo.save_regs_ref;
-
-            for r:=low(saved_standard_registers) to high(saved_standard_registers) do
-              begin
-                if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
-                  begin
-                    a_load_reg_ref(list,OS_ADDR,OS_ADDR,newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE),href);
-                    inc(href.offset,sizeof(aint));
-                  end;
-                include(rg[R_INTREGISTER].preserved_by_proc,saved_standard_registers[r]);
-              end;
-          end;
-      end;
-
-
-    procedure tcg.g_restore_standard_registers(list:Taasmoutput);
-      var
-        href : treference;
-        r : integer;
-        hreg : tregister;
-      begin
-        { Copy registers from temp }
-        href:=current_procinfo.save_regs_ref;
-        for r:=low(saved_standard_registers) to high(saved_standard_registers) do
-          if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
-            begin
-              hreg:=newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE);
-              { Allocate register so the optimizer does remove the load }
-              a_reg_alloc(list,hreg);
-              a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,hreg);
-              inc(href.offset,sizeof(aint));
-            end;
-        tg.UnGetTemp(list,current_procinfo.save_regs_ref);
-      end;
-
-
-    procedure tcg.g_profilecode(list : taasmoutput);
-      begin
-      end;
-
-
-    procedure tcg.g_exception_reason_save(list : taasmoutput; const href : treference);
-      begin
-        a_load_reg_ref(list, OS_INT, OS_INT, NR_FUNCTION_RESULT_REG, href);
-      end;
-
-
-    procedure tcg.g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aint);
-      begin
-        a_load_const_ref(list, OS_INT, a, href);
-      end;
-
-
-    procedure tcg.g_exception_reason_load(list : taasmoutput; const href : treference);
-      begin
-        a_load_ref_reg(list, OS_INT, OS_INT, href, NR_FUNCTION_RESULT_REG);
-      end;
-
-
-    procedure tcg.g_adjust_self_value(list:taasmoutput;procdef: tprocdef;ioffset: aint);
-      var
-        hsym : tsym;
-        href : treference;
-        paraloc : tcgparalocation;
-      begin
-        { calculate the parameter info for the procdef }
-        if not procdef.has_paraloc_info then
-          begin
-            procdef.requiredargarea:=paramanager.create_paraloc_info(procdef,callerside);
-            procdef.has_paraloc_info:=true;
-          end;
-        hsym:=tsym(procdef.parast.search('self'));
-        if not(assigned(hsym) and
-               (hsym.typ=paravarsym)) then
-          internalerror(200305251);
-        paraloc:=tparavarsym(hsym).paraloc[callerside].location^;
-        case paraloc.loc of
-          LOC_REGISTER:
-            cg.a_op_const_reg(list,OP_SUB,paraloc.size,ioffset,paraloc.register);
-          LOC_REFERENCE:
-            begin
-               { offset in the wrapper needs to be adjusted for the stored
-                 return address }
-               reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset+sizeof(aint));
-               cg.a_op_const_ref(list,OP_SUB,paraloc.size,ioffset,href);
-            end
-          else
-            internalerror(200309189);
-        end;
-      end;
-
-{*****************************************************************************
-                                    TCG64
-*****************************************************************************}
-
-{$ifndef cpu64bit}
-    procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64; regsrc,regdst : tregister64);
-      begin
-        a_load64_reg_reg(list,regsrc,regdst);
-        a_op64_const_reg(list,op,size,value,regdst);
-      end;
-
-
-    procedure tcg64.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
-      var
-        tmpreg64 : tregister64;
-      begin
-        { when src1=dst then we need to first create a temp to prevent
-          overwriting src1 with src2 }
-        if (regsrc1.reghi=regdst.reghi) or
-           (regsrc1.reglo=regdst.reghi) or
-           (regsrc1.reghi=regdst.reglo) or
-           (regsrc1.reglo=regdst.reglo) then
-          begin
-            tmpreg64.reglo:=cg.getintregister(list,OS_32);
-            tmpreg64.reghi:=cg.getintregister(list,OS_32);
-            a_load64_reg_reg(list,regsrc2,tmpreg64);
-            a_op64_reg_reg(list,op,size,regsrc1,tmpreg64);
-            a_load64_reg_reg(list,tmpreg64,regdst);
-          end
-        else
-          begin
-            a_load64_reg_reg(list,regsrc2,regdst);
-            a_op64_reg_reg(list,op,size,regsrc1,regdst);
-          end;
-      end;
-
-
-    procedure tcg64.a_op64_const_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
-      begin
-        a_op64_const_reg_reg(list,op,size,value,regsrc,regdst);
-        ovloc.loc:=LOC_VOID;
-      end;
-
-
-    procedure tcg64.a_op64_reg_reg_reg_checkoverflow(list: taasmoutput;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
-      begin
-        a_op64_reg_reg_reg(list,op,size,regsrc1,regsrc2,regdst);
-        ovloc.loc:=LOC_VOID;
-      end;
-
-
-{$endif cpu64bit}
-
-
-
-initialization
-    ;
-finalization
-  cg.free;
-{$ifndef cpu64bit}
-  cg64.free;
-{$endif cpu64bit}
-end.

compiler/compiler/cgutils.pas

@@ -1,186 +0,0 @@
-{
-    Copyright (c) 1998-2004 by Florian Klaempfl
-
-    Some basic types and constants for the code generation
-
-    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 exports some helper routines which are used across the code generator }
-unit cgutils;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    uses
-      globtype,
-      cclasses,
-      aasmbase,
-      cpubase,cgbase;
-
-    type
-      { reference record, reordered for best alignment }
-      preference = ^treference;
-      treference = record
-         offset      : aint;
-         symbol,
-         relsymbol   : tasmsymbol;
-         segment,
-         base,
-         index       : tregister;
-         refaddr     : trefaddr;
-         scalefactor : byte;
-{$ifdef arm}
-         symboldata  : tlinkedlistitem;
-         signindex   : shortint;
-         shiftimm    : byte;
-         addressmode : taddressmode;
-         shiftmode   : tshiftmode;
-{$endif arm}
-{$ifdef m68k}
-         { indexed increment and decrement mode }
-         { (An)+ and -(An)                      }
-         direction : tdirection;
-{$endif m68k}
-      end;
-
-      tlocation = record
-         loc  : TCGLoc;
-         size : TCGSize;
-         case TCGLoc of
-            LOC_FLAGS : (resflags : tresflags);
-            LOC_CONSTANT : (
-              case longint of
-{$ifdef FPC_BIG_ENDIAN}
-                1 : (_valuedummy,value : aint);
-{$else FPC_BIG_ENDIAN}
-                1 : (value : aint);
-{$endif FPC_BIG_ENDIAN}
-                2 : (value64 : Int64);
-              );
-            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 : tregister;
-{$ifdef m68k}
-                     { some m68k OSes require that the result is returned in d0 and a0
-                       the second location must be stored here }
-                     registeralias : tregister;
-{$endif m68k}
-                    );
-{$ifndef cpu64bit}
-                { overlay a 64 Bit register type }
-                2 : (register64 : tregister64);
-{$endif cpu64bit}
-              );
-      end;
-
-
-    { trerefence handling }
-
-    {# Clear to zero a treference }
-    procedure reference_reset(var ref : treference);
-    {# Clear to zero a treference, and set is base address
-       to base register.
-    }
-    procedure reference_reset_base(var ref : treference;base : tregister;offset : longint);
-    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
-    { This routine verifies if two references are the same, and
-       if so, returns TRUE, otherwise returns false.
-    }
-    function references_equal(sref : treference;dref : treference) : boolean;
-
-    { tlocation handling }
-
-    procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
-    procedure location_copy(var destloc:tlocation; const sourceloc : tlocation);
-    procedure location_swap(var destloc,sourceloc : tlocation);
-
-implementation
-
-{****************************************************************************
-                                  TReference
-****************************************************************************}
-
-    procedure reference_reset(var ref : treference);
-      begin
-        FillChar(ref,sizeof(treference),0);
-{$ifdef arm}
-        ref.signindex:=1;
-{$endif arm}
-      end;
-
-
-    procedure reference_reset_base(var ref : treference;base : tregister;offset : longint);
-      begin
-        reference_reset(ref);
-        ref.base:=base;
-        ref.offset:=offset;
-      end;
-
-
-    procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset : longint);
-      begin
-        reference_reset(ref);
-        ref.symbol:=sym;
-        ref.offset:=offset;
-      end;
-
-
-    function references_equal(sref : treference;dref : treference):boolean;
-      begin
-        references_equal:=CompareByte(sref,dref,sizeof(treference))=0;
-      end;
-
-
-{****************************************************************************
-                                  TLocation
-****************************************************************************}
-
-    procedure location_reset(var l : tlocation;lt:TCGLoc;lsize:TCGSize);
-      begin
-        FillChar(l,sizeof(tlocation),0);
-        l.loc:=lt;
-        l.size:=lsize;
-{$ifdef arm}
-        if l.loc in [LOC_REFERENCE,LOC_CREFERENCE] then
-          l.reference.signindex:=1;
-{$endif arm}
-      end;
-
-
-    procedure location_copy(var destloc:tlocation; const sourceloc : tlocation);
-      begin
-        destloc:=sourceloc;
-      end;
-
-
-    procedure location_swap(var destloc,sourceloc : tlocation);
-      var
-        swapl : tlocation;
-      begin
-        swapl := destloc;
-        destloc := sourceloc;
-        sourceloc := swapl;
-      end;
-
-
-
-end.

compiler/compiler/charset.pas

@@ -1,252 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2000 by Florian Klaempfl
-    member of the Free Pascal development team.
-
-    This unit implements several classes for charset conversions
-
-    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.
-
- **********************************************************************
-}
-unit charset;
-
-{$i fpcdefs.inc}
-
-  interface
-
-    type
-       tunicodechar = word;
-       tunicodestring = ^tunicodechar;
-
-       tcsconvert = class
-         // !!!!!!1constructor create;
-       end;
-
-       tunicodecharmappingflag = (umf_noinfo,umf_leadbyte,umf_undefined,
-         umf_unused);
-
-       punicodecharmapping = ^tunicodecharmapping;
-       tunicodecharmapping = record
-          unicode : tunicodechar;
-          flag : tunicodecharmappingflag;
-          reserved : byte;
-       end;
-
-       punicodemap = ^tunicodemap;
-       tunicodemap = record
-          cpname : string[20];
-          map : punicodecharmapping;
-          lastchar : longint;
-          next : punicodemap;
-          internalmap : boolean;
-       end;
-
-       tcp2unicode = class(tcsconvert)
-       end;
-
-    function loadunicodemapping(const cpname,f : string) : punicodemap;
-    procedure registermapping(p : punicodemap);
-    function getmap(const s : string) : punicodemap;
-    function mappingavailable(const s : string) : boolean;
-    function getunicode(c : char;p : punicodemap) : tunicodechar;
-    function getascii(c : tunicodechar;p : punicodemap) : string;
-
-  implementation
-
-    var
-       mappings : punicodemap;
-
-    function loadunicodemapping(const cpname,f : string) : punicodemap;
-
-      var
-         data : punicodecharmapping;
-         datasize : longint;
-         t : text;
-         s,hs : string;
-         scanpos,charpos,unicodevalue : longint;
-         code : integer;
-         flag : tunicodecharmappingflag;
-         p : punicodemap;
-         lastchar : longint;
-
-      begin
-         lastchar:=-1;
-         loadunicodemapping:=nil;
-         datasize:=256;
-         getmem(data,sizeof(tunicodecharmapping)*datasize);
-         assign(t,f);
-         {$I-}
-         reset(t);
-         {$I+}
-         if ioresult<>0 then
-           begin
-              freemem(data,sizeof(tunicodecharmapping)*datasize);
-              exit;
-           end;
-         while not(eof(t)) do
-           begin
-              readln(t,s);
-              if (s[1]='0') and (s[2]='x') then
-                begin
-                   flag:=umf_unused;
-                   scanpos:=3;
-                   hs:='$';
-                   while s[scanpos] in ['0'..'9','A'..'F','a'..'f'] do
-                     begin
-                        hs:=hs+s[scanpos];
-                        inc(scanpos);
-                     end;
-                   val(hs,charpos,code);
-                   if code<>0 then
-                     begin
-                        freemem(data,sizeof(tunicodecharmapping)*datasize);
-                        close(t);
-                        exit;
-                     end;
-                   while not(s[scanpos] in ['0','#']) do
-                     inc(scanpos);
-                   if s[scanpos]='#' then
-                     begin
-                        { special char }
-                        unicodevalue:=$ffff;
-                        hs:=copy(s,scanpos,length(s)-scanpos+1);
-                        if hs='#DBCS LEAD BYTE' then
-                          flag:=umf_leadbyte;
-                     end
-                   else
-                     begin
-                        { C hex prefix }
-                        inc(scanpos,2);
-                        hs:='$';
-                        while s[scanpos] in ['0'..'9','A'..'F','a'..'f'] do
-                          begin
-                             hs:=hs+s[scanpos];
-                             inc(scanpos);
-                          end;
-                        val(hs,unicodevalue,code);
-                        if code<>0 then
-                          begin
-                             freemem(data,sizeof(tunicodecharmapping)*datasize);
-                             close(t);
-                             exit;
-                          end;
-                        if charpos>datasize then
-                          begin
-                             { allocate 1024 bytes more because         }
-                             { if we need more than 256 entries it's    }
-                             { probably a mbcs with a lot of            }
-                             { entries                                  }
-                             datasize:=charpos+1024;
-                             reallocmem(data,sizeof(tunicodecharmapping)*datasize);
-                          end;
-                        flag:=umf_noinfo;
-                     end;
-                   data[charpos].flag:=flag;
-                   data[charpos].unicode:=unicodevalue;
-                   if charpos>lastchar then
-                     lastchar:=charpos;
-                end;
-           end;
-         close(t);
-         new(p);
-         p^.lastchar:=lastchar;
-         p^.cpname:=cpname;
-         p^.internalmap:=false;
-         p^.next:=nil;
-         p^.map:=data;
-         loadunicodemapping:=p;
-      end;
-
-    procedure registermapping(p : punicodemap);
-
-      begin
-         p^.next:=mappings;
-         mappings:=p;
-      end;
-
-    function getmap(const s : string) : punicodemap;
-
-      var
-         hp : punicodemap;
-
-      const
-         mapcachep : punicodemap = nil;
-
-      begin
-         if assigned(mapcachep) and
-            (mapcachep^.cpname=s) then
-           begin
-              getmap:=mapcachep;
-              exit;
-           end;
-         hp:=mappings;
-         while assigned(hp) do
-           begin
-              if hp^.cpname=s then
-                begin
-                   getmap:=hp;
-                   mapcachep:=hp;
-                   exit;
-                end;
-              hp:=hp^.next;
-           end;
-         getmap:=nil;
-      end;
-
-    function mappingavailable(const s : string) : boolean;
-
-      begin
-         mappingavailable:=getmap(s)<>nil;
-      end;
-
-    function getunicode(c : char;p : punicodemap) : tunicodechar;
-
-      begin
-         if ord(c)<=p^.lastchar then
-           getunicode:=p^.map[ord(c)].unicode
-         else
-           getunicode:=0;
-      end;
-
-    function getascii(c : tunicodechar;p : punicodemap) : string;
-
-      var
-         i : longint;
-
-      begin
-         { at least map to space }
-         getascii:=#32;
-         for i:=0 to p^.lastchar do
-           if p^.map[i].unicode=c then
-             begin
-                if i<256 then
-                  getascii:=chr(i)
-                else
-                  getascii:=chr(i div 256)+chr(i mod 256);
-                exit;
-             end;
-      end;
-
-  var
-     hp : punicodemap;
-
-initialization
-  mappings:=nil;
-finalization
-  while assigned(mappings) do
-    begin
-       hp:=mappings^.next;
-       if not(mappings^.internalmap) then
-         begin
-            freemem(mappings^.map);
-            dispose(mappings);
-         end;
-       mappings:=hp;
-    end;
-end.

compiler/compiler/cmsgs.pas

@@ -1,413 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Peter Vreman
-
-    This unit implements the message 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 cmsgs;
-
-{$i fpcdefs.inc}
-
-interface
-
-const
-  maxmsgidxparts = 20;
-
-type
-  ppchar=^pchar;
-
-  TArrayOfPChar = array[0..1000] of pchar;
-  PArrayOfPChar = ^TArrayOfPChar;
-
-  PMessage=^TMessage;
-  TMessage=object
-    msgfilename : string;
-    msgintern   : boolean;
-    msgallocsize,
-    msgsize,
-    msgparts,
-    msgs        : longint;
-    msgtxt      : pchar;
-    msgidx      : array[1..maxmsgidxparts] of PArrayOfPChar;
-    msgidxmax   : array[1..maxmsgidxparts] of longint;
-    constructor Init(n:longint;const idxmax:array of longint);
-    destructor  Done;
-    function  LoadIntern(p:pointer;n:longint):boolean;
-    function  LoadExtern(const fn:string):boolean;
-    procedure ClearIdx;
-    procedure CreateIdx;
-    function  GetPChar(nr:longint):pchar;
-    function  Get(nr:longint;const args:array of string):string;
-  end;
-
-{ this will read a line until #10 or #0 and also increase p }
-function GetMsgLine(var p:pchar):string;
-
-
-implementation
-
-uses
-  cutils,
-  strings;
-
-
-function MsgReplace(const s:string;const args:array of string):string;
-var
-  last,
-  i  : longint;
-  hs : string;
-
-begin
-  if s='' then
-    begin
-      MsgReplace:='';
-      exit;
-    end;
-  hs:='';
-  i:=0;
-  last:=0;
-  while (i<length(s)-1) do
-    begin
-      inc(i);
-      if (s[i]='$') and (s[i+1] in ['1'..'9']) then
-        begin
-          hs:=hs+copy(s,last+1,i-last-1)+args[byte(s[i+1])-byte('1')];
-          inc(i);
-          last:=i;
-        end;
-    end;
-  MsgReplace:=hs+copy(s,last+1,length(s)-last);;
-end;
-
-
-
-constructor TMessage.Init(n:longint;const idxmax:array of longint);
-var
-  i : longint;
-begin
-  msgtxt:=nil;
-  msgsize:=0;
-  msgparts:=n;
-  if n<>high(idxmax)+1 then
-   fail;
-  for i:=1 to n do
-   begin
-     msgidxmax[i]:=idxmax[i-1];
-     getmem(msgidx[i],msgidxmax[i]*sizeof(pointer));
-     fillchar(msgidx[i]^,msgidxmax[i]*sizeof(pointer),0);
-   end;
-end;
-
-
-destructor TMessage.Done;
-var
-  i : longint;
-begin
-  for i:=1 to msgparts do
-   freemem(msgidx[i],msgidxmax[i]*sizeof(pointer));
-  if msgallocsize>0 then
-   begin
-     freemem(msgtxt,msgsize);
-     msgallocsize:=0;
-   end;
-  msgtxt:=nil;
-  msgsize:=0;
-  msgparts:=0;
-end;
-
-
-function TMessage.LoadIntern(p:pointer;n:longint):boolean;
-begin
-  msgtxt:=pchar(p);
-  msgsize:=n;
-  msgallocsize:=0;
-  msgintern:=true;
-  ClearIdx;
-  CreateIdx;
-  LoadIntern:=true;
-end;
-
-
-function TMessage.LoadExtern(const fn:string):boolean;
-
-{$ifndef FPC}
-  procedure readln(var t:text;var s:string);
-  var
-    c : char;
-    i : longint;
-  begin
-    c:=#0;
-    i:=0;
-    while (not eof(t)) and (c<>#10) do
-     begin
-       read(t,c);
-       if c<>#10 then
-        begin
-          inc(i);
-          s[i]:=c;
-        end;
-     end;
-    if (i>0) and (s[i]=#13) then
-     dec(i);
-    s[0]:=chr(i);
-  end;
-{$endif}
-
-const
-  bufsize=8192;
-var
-  f       : text;
-  error,multiline : boolean;
-  line,i,j : longint;
-  ptxt    : pchar;
-  s,s1    : string;
-  buf     : pointer;
-
-  procedure err(const msgstr:string);
-  begin
-    writeln('*** PPC, file ',fn,', error in line ',line,': ',msgstr);
-    error:=true;
-  end;
-
-begin
-  LoadExtern:=false;
-  getmem(buf,bufsize);
-  { Read the message file }
-  assign(f,fn);
-  {$I-}
-   reset(f);
-  {$I+}
-  if ioresult<>0 then
-   begin
-     WriteLn('*** PPC, can not open message file ',fn);
-     exit;
-   end;
-  settextbuf(f,buf^,bufsize);
-  { First parse the file and count bytes needed }
-  error:=false;
-  line:=0;
-  multiline:=false;
-  msgsize:=0;
-  while not eof(f) do
-   begin
-     readln(f,s);
-     inc(line);
-     if multiline then
-      begin
-        if s=']' then
-         multiline:=false
-        else
-         inc(msgsize,length(s)+1); { +1 for linebreak }
-      end
-     else
-      begin
-        if (s<>'') and not(s[1] in ['#',';','%']) then
-         begin
-           i:=pos('=',s);
-           if i>0 then
-            begin
-              j:=i+1;
-              if not(s[j] in ['0'..'9']) then
-               err('no number found')
-              else
-               begin
-                 while (s[j] in ['0'..'9']) do
-                  inc(j);
-               end;
-              if j-i-1<>5 then
-               err('number length is not 5');
-              if s[j+1]='[' then
-               begin
-                 inc(msgsize,j-i);
-                 multiline:=true
-               end
-              else
-               inc(msgsize,length(s)-i+1);
-            end
-           else
-            err('no = found');
-         end;
-      end;
-   end;
-  if multiline then
-   err('still in multiline mode');
-  if error then
-   begin
-     freemem(buf,bufsize);
-     close(f);
-     exit;
-   end;
-  { now read the buffer in mem }
-  msgallocsize:=msgsize;
-  getmem(msgtxt,msgallocsize);
-  ptxt:=msgtxt;
-  reset(f);
-  while not eof(f) do
-   begin
-     readln(f,s);
-     if multiline then
-      begin
-        if s=']' then
-         begin
-           multiline:=false;
-           { overwrite last eol }
-           dec(ptxt);
-           ptxt^:=#0;
-           inc(ptxt);
-         end
-        else
-         begin
-           move(s[1],ptxt^,length(s));
-           inc(ptxt,length(s));
-           ptxt^:=#10;
-           inc(ptxt);
-         end;
-      end
-     else
-      begin
-        if (s<>'') and not(s[1] in ['#',';','%']) then
-         begin
-           i:=pos('=',s);
-           if i>0 then
-            begin
-              j:=i+1;
-              while (s[j] in ['0'..'9']) do
-               inc(j);
-              { multiline start then no txt }
-              if s[j+1]='[' then
-               begin
-                 s1:=Copy(s,i+1,j-i);
-                 move(s1[1],ptxt^,length(s1));
-                 inc(ptxt,length(s1));
-                 multiline:=true;
-               end
-              else
-               begin
-                 { txt including number }
-                 s1:=Copy(s,i+1,255);
-                 move(s1[1],ptxt^,length(s1));
-                 inc(ptxt,length(s1));
-                 ptxt^:=#0;
-                 inc(ptxt);
-               end;
-            end;
-         end;
-      end;
-   end;
-  close(f);
-  freemem(buf,bufsize);
-{ now we can create the index, clear if the previous load was also
-  an external file, because those can't be reused }
-  if not msgintern then
-   ClearIdx;
-  CreateIdx;
-{ set that we've loaded an external file }
-  msgintern:=false;
-  LoadExtern:=true;
-end;
-
-
-procedure TMessage.ClearIdx;
-var
-  i : longint;
-begin
-  { clear }
-  for i:=1 to msgparts do
-   fillchar(msgidx[i]^,msgidxmax[i]*sizeof(pointer),0);
-end;
-
-
-procedure TMessage.CreateIdx;
-var
-  hp1,
-  hp,hpend : pchar;
-  code : integer;
-  num  : longint;
-  number : string[5];
-  i   : longint;
-  numpart,numidx : longint;
-begin
-  { process msgtxt buffer }
-  number:='00000';
-  hp:=msgtxt;
-  hpend:=@msgtxt[msgsize];
-  while (hp<hpend) do
-   begin
-     hp1:=hp;
-     for i:=1 to 5 do
-      begin
-        number[i]:=hp1^;
-        inc(hp1);
-      end;
-     val(number,num,code);
-     numpart:=num div 1000;
-     numidx:=num mod 1000;
-     { check range }
-     if (numpart <= msgparts) and (numidx < msgidxmax[numpart]) then
-      begin
-        { skip _ }
-        inc(hp1);
-        { put the address in the idx, the numbers are already checked }
-        msgidx[numpart]^[numidx]:=hp1;
-      end;
-     { next string }
-     hp:=pchar(@hp[strlen(hp)+1]);
-   end;
-end;
-
-
-function GetMsgLine(var p:pchar):string;
-var
-  i  : longint;
-begin
-  i:=0;
-  while not(p^ in [#0,#10]) and (i<255) do
-   begin
-     inc(i);
-     GetMsgLine[i]:=p^;
-     inc(p);
-   end;
-  { skip #10 }
-  if p^=#10 then
-   inc(p);
-  { if #0 then set p to nil }
-  if p^=#0 then
-   p:=nil;
-  { return string }
-  GetMsgLine[0]:=chr(i);
-end;
-
-
-function TMessage.GetPChar(nr:longint):pchar;
-begin
-  GetPChar:=msgidx[nr div 1000]^[nr mod 1000];
-end;
-
-
-function TMessage.Get(nr:longint;const args:array of string):string;
-var
-  hp : pchar;
-begin
-  hp:=msgidx[nr div 1000]^[nr mod 1000];
-  if hp=nil then
-    Get:='msg nr '+tostr(nr)
-  else
-    Get:=MsgReplace(strpas(hp),args);
-end;
-
-end.

compiler/compiler/comphook.pas

@@ -1,413 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Peter Vreman
-
-    This unit handles the compilerhooks for output to external programs
-
-    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 comphook;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
-  SysUtils,
-{$ELSE}
-  globals,
-{$ENDIF}
-  finput;
-
-Const
-  { Levels }
-  V_None         = $0;
-  V_Fatal        = $1;
-  V_Error        = $2;
-  V_Normal       = $4; { doesn't show a text like Error: }
-  V_Warning      = $8;
-  V_Note         = $10;
-  V_Hint         = $20;
-  V_LineInfoMask = $fff;
-  { From here by default no line info }
-  V_Info         = $1000;
-  V_Status       = $2000;
-  V_Used         = $4000;
-  V_Tried        = $8000;
-  V_Conditional  = $10000;
-  V_Debug        = $20000;
-  V_Executable   = $40000;
-  V_LevelMask    = $fffffff;
-  V_All          = V_LevelMask;
-  V_Default      = V_Fatal + V_Error + V_Normal;
-  { Flags }
-  V_LineInfo     = $10000000;
-
-const
-  { RHIDE expect gcc like error output }
-  fatalstr      : string[20] = 'Fatal:';
-  errorstr      : string[20] = 'Error:';
-  warningstr    : string[20] = 'Warning:';
-  notestr       : string[20] = 'Note:';
-  hintstr       : string[20] = 'Hint:';
-
-type
-  PCompilerStatus = ^TCompilerStatus;
-  TCompilerStatus = record
-  { Current status }
-    currentmodule,
-    currentsourcepath,
-    currentsource : string;   { filename }
-    currentline,
-    currentcolumn : longint;  { current line and column }
-  { Total Status }
-    compiledlines : longint;  { the number of lines which are compiled }
-    errorcount    : longint;  { number of generated errors }
-  { program info }
-    isexe,
-    islibrary     : boolean;
-  { Settings for the output }
-    verbosity     : longint;
-    maxerrorcount : longint;
-    errorwarning,
-    errornote,
-    errorhint,
-    skip_error,
-    use_stderr,
-    use_redir,
-    use_bugreport,
-    use_gccoutput,
-    print_source_path,
-    compiling_current : boolean;
-  { Redirection support }
-    redirfile : text;
-  { Special file for bug report }
-    reportbugfile : text;
-  end;
-var
-  status : tcompilerstatus;
-
-    type
-      EControlCAbort=class(Exception)
-        constructor Create;
-      end;
-      ECompilerAbort=class(Exception)
-        constructor Create;
-      end;
-      ECompilerAbortSilent=class(Exception)
-        constructor Create;
-      end;
-
-{ Default Functions }
-Function  def_status:boolean;
-Function  def_comment(Level:Longint;const s:string):boolean;
-function  def_internalerror(i:longint):boolean;
-procedure def_initsymbolinfo;
-procedure def_donesymbolinfo;
-procedure def_extractsymbolinfo;
-function  def_openinputfile(const filename: string): tinputfile;
-Function  def_getnamedfiletime(Const F : String) : Longint;
-{ Function redirecting for IDE support }
-type
-  tstopprocedure         = procedure(err:longint);
-  tstatusfunction        = function:boolean;
-  tcommentfunction       = function(Level:Longint;const s:string):boolean;
-  tinternalerrorfunction = function(i:longint):boolean;
-
-  tinitsymbolinfoproc = procedure;
-  tdonesymbolinfoproc = procedure;
-  textractsymbolinfoproc = procedure;
-  topeninputfilefunc = function(const filename: string): tinputfile;
-  tgetnamedfiletimefunc = function(const filename: string): longint;
-
-const
-  do_status        : tstatusfunction  = @def_status;
-  do_comment       : tcommentfunction = @def_comment;
-  do_internalerror : tinternalerrorfunction = @def_internalerror;
-
-  do_initsymbolinfo : tinitsymbolinfoproc = @def_initsymbolinfo;
-  do_donesymbolinfo : tdonesymbolinfoproc = @def_donesymbolinfo;
-  do_extractsymbolinfo : textractsymbolinfoproc = @def_extractsymbolinfo;
-
-  do_openinputfile : topeninputfilefunc = @def_openinputfile;
-  do_getnamedfiletime : tgetnamedfiletimefunc = @def_getnamedfiletime;
-
-implementation
-
-  uses
-{$IFNDEF USE_SYSUTILS}
-   dos,
-{$ENDIF USE_SYSUTILS}
-   cutils
-   ;
-
-{****************************************************************************
-                          Helper Routines
-****************************************************************************}
-
-function gccfilename(const s : string) : string;
-var
-  i : longint;
-begin
-  for i:=1to length(s) do
-   begin
-     case s[i] of
-      '\' : gccfilename[i]:='/';
- 'A'..'Z' : gccfilename[i]:=chr(ord(s[i])+32);
-     else
-      gccfilename[i]:=s[i];
-     end;
-   end;
-  gccfilename[0]:=s[0];
-end;
-
-
-function tostr(i : longint) : string;
-var
-  hs : string;
-begin
-  str(i,hs);
-  tostr:=hs;
-end;
-
-
-{****************************************************************************
-                          Stopping the compiler
-****************************************************************************}
-
-     constructor EControlCAbort.Create;
-       begin
-{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
-         inherited Create('Ctrl-C Signaled!');
-{$ELSE}
-         inherited Create;
-{$ENDIF}
-       end;
-
-
-     constructor ECompilerAbort.Create;
-       begin
-{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
-         inherited Create('Compilation Aborted');
-{$ELSE}
-         inherited Create;
-{$ENDIF}
-       end;
-
-
-     constructor ECompilerAbortSilent.Create;
-       begin
-{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
-         inherited Create('Compilation Aborted');
-{$ELSE}
-         inherited Create;
-{$ENDIF}
-       end;
-
-
-{****************************************************************************
-                         Predefined default Handlers
-****************************************************************************}
-
-function def_status:boolean;
-var
-  hstatus : TFPCHeapStatus;
-begin
-  def_status:=false; { never stop }
-{ Status info?, Called every line }
-  if ((status.verbosity and V_Status)<>0) then
-   begin
-     if (status.compiledlines=1) or
-        (status.currentline mod 100=0) then
-       begin
-         if status.currentline>0 then
-           Write(status.currentline,' ');
-         hstatus:=GetFPCHeapStatus;
-         WriteLn(DStr(hstatus.CurrHeapUsed shr 10),'/',DStr(hstatus.CurrHeapSize shr 10),' Kb Used');
-       end;
-   end;
-{$ifdef macos}
-  Yield;
-{$endif}
-end;
-
-
-Function def_comment(Level:Longint;const s:string):boolean;
-const
-  rh_errorstr   = 'error:';
-  rh_warningstr = 'warning:';
-var
-  hs : string;
-begin
-  def_comment:=false; { never stop }
-  hs:='';
-  if not(status.use_gccoutput) then
-    begin
-      if (status.verbosity and Level)=V_Hint then
-        hs:=hintstr;
-      if (status.verbosity and Level)=V_Note then
-        hs:=notestr;
-      if (status.verbosity and Level)=V_Warning then
-        hs:=warningstr;
-      if (status.verbosity and Level)=V_Error then
-        hs:=errorstr;
-      if (status.verbosity and Level)=V_Fatal then
-        hs:=fatalstr;
-      if (status.verbosity and Level)=V_Used then
-        hs:=PadSpace('('+status.currentmodule+')',10);
-    end
-  else
-    begin
-      if (status.verbosity and Level)=V_Hint then
-        hs:=rh_warningstr;
-      if (status.verbosity and Level)=V_Note then
-        hs:=rh_warningstr;
-      if (status.verbosity and Level)=V_Warning then
-        hs:=rh_warningstr;
-      if (status.verbosity and Level)=V_Error then
-        hs:=rh_errorstr;
-      if (status.verbosity and Level)=V_Fatal then
-        hs:=rh_errorstr;
-    end;
-  { Generate line prefix }
-  if ((Level and V_LineInfo)=V_LineInfo) and
-     (status.currentsource<>'') and
-     (status.currentline>0) then
-   begin
-     {$ifndef macos}
-     { Adding the column should not confuse RHIDE,
-     even if it does not yet use it PM
-     but only if it is after error or warning !! PM }
-     if status.currentcolumn>0 then
-      begin
-        if status.use_gccoutput then
-          hs:=gccfilename(status.currentsource)+':'+tostr(status.currentline)+': '+hs+' '+
-              tostr(status.currentcolumn)+': '+s
-        else
-          begin
-            hs:=status.currentsource+'('+tostr(status.currentline)+
-              ','+tostr(status.currentcolumn)+') '+hs+' '+s;
-            if status.print_source_path then
-              hs:=status.currentsourcepath+hs;
-          end;
-      end
-     else
-      begin
-        if status.use_gccoutput then
-          hs:=gccfilename(status.currentsource)+': '+hs+' '+tostr(status.currentline)+': '+s
-        else
-          hs:=status.currentsource+'('+tostr(status.currentline)+') '+hs+' '+s;
-      end;
-     {$else}
-     {MPW style error}
-     if status.currentcolumn>0 then
-       hs:='File "'+status.currentsourcepath+status.currentsource+'"; Line '+tostr(status.currentline)+
-         ' #[' + tostr(status.currentcolumn) + '] ' +hs+' '+s
-     else
-       hs:='File "'+status.currentsourcepath+status.currentsource+'"; Line '+tostr(status.currentline)+' # '+hs+' '+s;
-     {$endif}
-   end
-  else
-   begin
-     if hs<>'' then
-      hs:=hs+' '+s
-     else
-      hs:=s;
-   end;
-
-  { Display line }
-  if ((status.verbosity and (Level and V_LevelMask))=(Level and V_LevelMask)) then
-   begin
-{$ifdef FPC}
-     if status.use_stderr then
-      begin
-        writeln(stderr,hs);
-        flush(stderr);
-      end
-     else
-{$endif}
-      begin
-        if status.use_redir then
-         writeln(status.redirfile,hs)
-        else
-         writeln(hs);
-      end;
-   end;
-  { include everything in the bugreport file }
-  if status.use_bugreport then
-   begin
-{$ifdef FPC}
-     Write(status.reportbugfile,hexstr(level,8)+':');
-     Writeln(status.reportbugfile,hs);
-{$endif}
-   end;
-end;
-
-
-function def_internalerror(i : longint) : boolean;
-begin
-  do_comment(V_Fatal+V_LineInfo,'Internal error '+tostr(i));
-{$ifdef EXTDEBUG}
-  {$ifdef FPC}
-    { Internalerror() and def_internalerror() do not
-      have a stackframe }
-    dump_stack(stdout,get_caller_frame(get_frame));
-  {$endif FPC}
-{$endif EXTDEBUG}
-  def_internalerror:=true;
-end;
-
-procedure def_initsymbolinfo;
-begin
-end;
-
-procedure def_donesymbolinfo;
-begin
-end;
-
-procedure def_extractsymbolinfo;
-begin
-end;
-
-function  def_openinputfile(const filename: string): tinputfile;
-begin
-  def_openinputfile:=tdosinputfile.create(filename);
-end;
-
-
-Function def_GetNamedFileTime (Const F : String) : Longint;
-var
-{$IFDEF USE_SYSUTILS}
-  fh : THandle;
-{$ELSE USE_SYSUTILS}
-  info : SearchRec;
-{$ENDIF USE_SYSUTILS}
-begin
-  Result := -1;
-{$IFDEF USE_SYSUTILS}
-  fh := FileOpen(f, faArchive+faReadOnly+faHidden);
-  Result := FileGetDate(fh);
-  FileClose(fh);
-{$ELSE USE_SYSUTILS}
-  FindFirst (F,archive+readonly+hidden,info);
-  if DosError=0 then
-    Result := info.time;
-  FindClose(info);
-{$ENDIF USE_SYSUTILS}
-end;
-
-end.

compiler/compiler/compiler.pas

@@ -1,450 +0,0 @@
-{
-    This unit is the interface of the compiler which can be used by
-    external programs to link in the compiler
-
-    Copyright (c) 1998-2005 by Florian Klaempfl
-
-    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 compiler;
-
-{$i fpcdefs.inc}
-
-{$ifdef FPC}
-   { One of Alpha, I386 or M68K must be defined }
-   {$UNDEF CPUOK}
-
-   {$ifdef I386}
-   {$define CPUOK}
-   {$endif}
-
-   {$ifdef M68K}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-
-   {$ifdef alpha}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-
-   {$ifdef vis}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-
-
-   {$ifdef powerpc}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-   
-   {$ifdef POWERPC64}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}   
-
-   {$ifdef ia64}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-
-   {$ifdef SPARC}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-
-   {$ifdef x86_64}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif}
-   {$endif}
-
-   {$ifdef ARM}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif ARM}
-   {$endif ARM}
-
-
-   {$ifdef MIPS}
-   {$ifndef CPUOK}
-   {$DEFINE CPUOK}
-   {$else}
-     {$fatal cannot define two CPU switches}
-   {$endif MIPS}
-   {$endif MIPS}
-
-   {$ifndef CPUOK}
-   {$fatal One of the switches I386, iA64, Alpha, PowerPC or M68K must be defined}
-   {$endif}
-
-   {$ifdef support_mmx}
-     {$ifndef i386}
-       {$fatal I386 switch must be on for MMX support}
-     {$endif i386}
-   {$endif support_mmx}
-{$endif}
-
-interface
-
-uses
-{$ifdef fpc}
-  {$ifdef GO32V2}
-    emu387,
-  {$endif GO32V2}
-  {$ifdef WATCOM} // wiktor: pewnie nie potrzeba
-    emu387,
-{    dpmiexcp, }
-  {$endif WATCOM}
-{$endif}
-{$ifdef BrowserLog}
-  browlog,
-{$endif BrowserLog}
-{$IFDEF USE_SYSUTILS}
-{$ELSE USE_SYSUTILS}
-  dos,
-{$ENDIF USE_SYSUTILS}
-{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
-  sysutils,
-{$ENDIF MACOS_USE_FAKE_SYSUTILS}
-  verbose,comphook,systems,
-  cutils,cclasses,globals,options,fmodule,parser,symtable,
-  assemble,link,dbgbase,import,export,tokens,pass_1
-  { cpu specific commandline options }
-  ,cpuswtch
-  { cpu parameter handling }
-  ,cpupara
-  { procinfo stuff }
-  ,cpupi
-  { cpu codegenerator }
-  ,cgcpu
-{$ifndef NOPASS2}
-  ,cpunode
-{$endif}
-  { cpu targets }
-  ,cputarg
-  { system information for source system }
-  { the information about the target os  }
-  { are pulled in by the t_* units       }
-{$ifdef amiga}
-  ,i_amiga
-{$endif amiga}
-{$ifdef atari}
-  ,i_atari
-{$endif atari}
-{$ifdef beos}
-  ,i_beos
-{$endif beos}
-{$ifdef fbsd}
-  ,i_fbsd
-{$endif fbsd}
-{$ifdef gba}
-  ,i_gba
-{$endif gba}
-{$ifdef go32v2}
-  ,i_go32v2
-{$endif go32v2}
-{$ifdef linux}
-  ,i_linux
-{$endif linux}
-{$ifdef macos}
-  ,i_macos
-{$endif macos}
-{$ifdef nwm}
-  ,i_nwm
-{$endif nwm}
-{$ifdef nwl}
-  ,i_nwl
-{$endif nwm}
-{$ifdef os2}
- {$ifdef emx}
-  ,i_emx
- {$else emx}
-  ,i_os2
- {$endif emx}
-{$endif os2}
-{$ifdef palmos}
-  ,i_palmos
-{$endif palmos}
-{$ifdef solaris}
-  ,i_sunos
-{$endif solaris}
-{$ifdef wdosx}
-  ,i_wdosx
-{$endif wdosx}
-{$ifdef win32}
-  ,i_win
-{$endif win32}
-  ;
-
-function Compile(const cmd:string):longint;
-
-
-implementation
-
-uses
-  aasmcpu;
-
-{$ifdef EXTDEBUG}
-  {$define SHOWUSEDMEM}
-{$endif}
-{$ifdef MEMDEBUG}
-  {$define SHOWUSEDMEM}
-{$endif}
-
-var
-  CompilerInitedAfterArgs,
-  CompilerInited : boolean;
-
-
-{****************************************************************************
-                                Compiler
-****************************************************************************}
-
-procedure DoneCompiler;
-begin
-  if not CompilerInited then
-   exit;
-{ Free compiler if args are read }
-{$ifdef BrowserLog}
-  DoneBrowserLog;
-{$endif BrowserLog}
-{$ifdef BrowserCol}
-  do_doneSymbolInfo;
-{$endif BrowserCol}
-  if CompilerInitedAfterArgs then
-   begin
-     CompilerInitedAfterArgs:=false;
-     DoneParser;
-     DoneImport;
-     DoneExport;
-     DoneDebuginfo;
-     DoneLinker;
-     DoneAssembler;
-     DoneAsm;
-   end;
-{ Free memory for the others }
-  CompilerInited:=false;
-  DoneSymtable;
-  DoneGlobals;
-  donetokens;
-end;
-
-
-procedure InitCompiler(const cmd:string);
-begin
-  if CompilerInited then
-   DoneCompiler;
-{ inits which need to be done before the arguments are parsed }
-  InitSystems;
-  { globals depends on source_info so it must be after systems }
-  InitGlobals;
-  { verbose depends on exe_path and must be after globals }
-  InitVerbose;
-{$ifdef BrowserLog}
-  InitBrowserLog;
-{$endif BrowserLog}
-{$ifdef BrowserCol}
-  do_initSymbolInfo;
-{$endif BrowserCol}
-  inittokens;
-  InitSymtable; {Must come before read_arguments, to enable macrosymstack}
-  CompilerInited:=true;
-{ this is needed here for the IDE
-  in case of compilation failure
-  at the previous compile }
-  current_module:=nil;
-{ read the arguments }
-  read_arguments(cmd);
-{ inits which depend on arguments }
-  InitParser;
-  InitImport;
-  InitExport;
-  InitLinker;
-  InitAssembler;
-  InitDebugInfo;
-  InitAsm;
-  CompilerInitedAfterArgs:=true;
-end;
-
-
-function Compile(const cmd:string):longint;
-
-{$ifdef fpc}
-{$maxfpuregisters 0}
-{$endif fpc}
-
-  procedure writepathlist(w:longint;l:TSearchPathList);
-  var
-    hp : tstringlistitem;
-  begin
-    hp:=tstringlistitem(l.first);
-    while assigned(hp) do
-     begin
-       Message1(w,hp.str);
-       hp:=tstringlistitem(hp.next);
-     end;
-  end;
-
-  function getrealtime : real;
-  var
-{$IFDEF USE_SYSUTILS}
-    h,m,s,s1000 : word;
-{$ELSE USE_SYSUTILS}
-    h,m,s,s100 : word;
-{$ENDIF USE_SYSUTILS}
-  begin
-{$IFDEF USE_SYSUTILS}
-    DecodeTime(Time,h,m,s,s1000);
-    getrealtime:=h*3600.0+m*60.0+s+s1000/1000.0;
-{$ELSE USE_SYSUTILS}
-    gettime(h,m,s,s100);
-    getrealtime:=h*3600.0+m*60.0+s+s100/100.0;
-{$ENDIF USE_SYSUTILS}
-  end;
-
-var
-  starttime  : real;
-{$ifdef SHOWUSEDMEM}
-  hstatus : TFPCHeapStatus;
-{$endif SHOWUSEDMEM}
-begin
-  try
-    try
-       { Initialize the compiler }
-       InitCompiler(cmd);
-
-       { show some info }
-       Message1(general_t_compilername,FixFileName(system.paramstr(0)));
-       Message1(general_d_sourceos,source_info.name);
-       Message1(general_i_targetos,target_info.name);
-       Message1(general_t_exepath,exepath);
-       WritePathList(general_t_unitpath,unitsearchpath);
-       WritePathList(general_t_includepath,includesearchpath);
-       WritePathList(general_t_librarypath,librarysearchpath);
-       WritePathList(general_t_objectpath,objectsearchpath);
-
-       starttime:=getrealtime;
-
-       { Compile the program }
-  {$ifdef PREPROCWRITE}
-       if parapreprocess then
-        parser.preprocess(inputdir+inputfile+inputextension)
-       else
-  {$endif PREPROCWRITE}
-        parser.compile(inputdir+inputfile+inputextension);
-
-       { Show statistics }
-       if status.errorcount=0 then
-        begin
-          starttime:=getrealtime-starttime;
-          if starttime<0 then
-            starttime:=starttime+3600.0*24.0;
-          Message2(general_i_abslines_compiled,tostr(status.compiledlines),tostr(trunc(starttime))+
-            '.'+tostr(trunc(frac(starttime)*10)));
-        end;
-     finally
-       { no message possible after this !!    }
-       DoneCompiler;
-     end;
-  except
-
-    on EControlCAbort do
-      begin
-        try
-          { in case of 50 errors, this could cause another exception,
-            suppress this exception
-          }
-          Message(general_f_compilation_aborted);
-        except
-          on ECompilerAbort do
-            ;
-        end;
-        DoneVerbose;
-      end;
-    on ECompilerAbort do
-      begin
-        try
-          { in case of 50 errors, this could cause another exception,
-            suppress this exception
-          }
-          Message(general_f_compilation_aborted);
-        except
-          on ECompilerAbort do
-            ;
-        end;
-        DoneVerbose;
-      end;
-    on ECompilerAbortSilent do
-      begin
-        DoneVerbose;
-      end;
-    on Exception do
-      begin
-        { General catchall, normally not used }
-        try
-          { in case of 50 errors, this could cause another exception,
-            suppress this exception
-          }
-          Message(general_f_compilation_aborted);
-        except
-          on ECompilerAbort do
-            ;
-        end;
-        DoneVerbose;
-        Raise;
-      end;
-  end;
-{$ifdef SHOWUSEDMEM}
-      hstatus:=GetFPCHeapStatus;
-      Writeln('Max Memory used/heapsize: ',DStr(hstatus.MaxHeapUsed shr 10),'/',DStr(hstatus.MaxHeapSize shr 10),' Kb');
-{$endif SHOWUSEDMEM}
-
-  { Set the return value if an error has occurred }
-  if status.errorcount=0 then
-    result:=0
-  else
-    result:=1;
-end;
-
-end.

compiler/compiler/compinnr.inc

@@ -1,107 +0,0 @@
-{
-    This file is part of the Free Pascal run time library and compiler.
-    Copyright (c) 1998-2002 by the Free Pascal development team
-
-    Internal Function/Constant Evaluator numbers
-
-    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.
-
- **********************************************************************}
-
-const
-{ Internal functions }
-   in_lo_word           = 1;
-   in_hi_word           = 2;
-   in_lo_long           = 3;
-   in_hi_long           = 4;
-   in_ord_x             = 5;
-   in_length_x          = 6;
-   in_chr_byte          = 7;
-   in_write_x           = 14;
-   in_writeln_x         = 15;
-   in_read_x            = 16;
-   in_readln_x          = 17;
-   in_concat_x          = 18;
-   in_assigned_x        = 19;
-   in_str_x_string      = 20;
-   in_ofs_x             = 21;
-   in_sizeof_x          = 22;
-   in_typeof_x          = 23;
-   in_val_x             = 24;
-   in_reset_x           = 25;
-   in_rewrite_x         = 26;
-   in_low_x             = 27;
-   in_high_x            = 28;
-   in_seg_x             = 29;
-   in_pred_x            = 30;
-   in_succ_x            = 31;
-   in_reset_typedfile   = 32;
-   in_rewrite_typedfile = 33;
-   in_settextbuf_file_x = 34;
-   in_inc_x             = 35;
-   in_dec_x             = 36;
-   in_include_x_y       = 37;
-   in_exclude_x_y       = 38;
-   in_break             = 39;
-   in_continue          = 40;
-   in_assert_x_y        = 41;
-   in_addr_x            = 42;
-   in_typeinfo_x        = 43;
-   in_setlength_x       = 44;
-   in_finalize_x        = 45;
-   in_new_x             = 46;
-   in_dispose_x         = 47;
-   in_exit              = 48;
-   in_copy_x            = 49;
-   in_initialize_x      = 50;
-   in_leave             = 51; {macpas}
-   in_cycle             = 52; {macpas}
-   in_slice_x           = 53;
-
-{ Internal constant functions }
-   in_const_sqr        = 100;
-   in_const_abs        = 101;
-   in_const_odd        = 102;
-   in_const_ptr        = 103;
-   in_const_swap_word  = 104;
-   in_const_swap_long  = 105;
-   in_lo_qword         = 106;
-   in_hi_qword         = 107;
-   in_const_swap_qword = 108;
-   in_prefetch_var     = 109;
-
-{ FPU functions }
-   in_trunc_real       = 120;
-   in_round_real       = 121;
-   in_frac_real        = 122;
-   in_int_real         = 123;
-   in_exp_real         = 124;
-   in_cos_real         = 125;
-   in_pi_real          = 126;
-   in_abs_real         = 127;
-   in_sqr_real         = 128;
-   in_sqrt_real        = 129;
-   in_arctan_real      = 130;
-   in_ln_real          = 131;
-   in_sin_real         = 132;
-
-{ MMX functions }
-  { these contants are used by the mmx unit }
-
-   { MMX }
-   in_mmx_pcmpeqb      = 200;
-   in_mmx_pcmpeqw      = 201;
-   in_mmx_pcmpeqd      = 202;
-   in_mmx_pcmpgtb      = 203;
-   in_mmx_pcmpgtw      = 204;
-   in_mmx_pcmpgtd      = 205;
-
-   { 3DNow }
-
-   { SSE }
-

compiler/compiler/comprsrc.pas

@@ -1,185 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    Handles the resource files handling
-
-    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 comprsrc;
-
-{$i fpcdefs.inc}
-
-interface
-
-type
-   presourcefile=^tresourcefile;
-   tresourcefile=object
-   private
-      fname : string;
-   public
-      constructor Init(const fn:string);
-      destructor Done;
-      procedure  Compile;virtual;
-   end;
-
-procedure CompileResourceFiles;
-
-
-implementation
-
-uses
-{$IFDEF USE_SYSUTILS}
-  SysUtils,
-{$ELSE USE_SYSUTILS}
-  dos,
-{$ENDIF USE_SYSUTILS}
-  Systems,cutils,Globtype,Globals,Verbose,Fmodule,
-  Script;
-
-{****************************************************************************
-                              TRESOURCEFILE
-****************************************************************************}
-
-constructor tresourcefile.init(const fn:string);
-begin
-  fname:=fn;
-end;
-
-
-destructor tresourcefile.done;
-begin
-end;
-
-
-procedure tresourcefile.compile;
-var
-  respath,
-  srcfilepath : dirstr;
-  n       : namestr;
-{$IFDEF USE_SYSUTILS}
-{$ELSE USE_SYSUTILS}
-  e       : extstr;
-{$ENDIF USE_SYSUTILS}
-  s,
-  resobj,
-  resbin   : string;
-  resfound,
-  objused  : boolean;
-begin
-  resbin:='';
-  resfound:=false;
-  if utilsdirectory<>'' then
-    resfound:=FindFile(utilsprefix+target_res.resbin+source_info.exeext,utilsdirectory,resbin);
-  if not resfound then
-    resfound:=FindExe(utilsprefix+target_res.resbin,resbin);
-  { get also the path to be searched for the windres.h }
-{$IFDEF USE_SYSUTILS}
-  respath := SplitPath(resbin);
-{$ELSE USE_SYSUTILS}
-  fsplit(resbin,respath,n,e);
-{$ENDIF USE_SYSUTILS}
-  if (not resfound) and not(cs_link_extern in aktglobalswitches) then
-   begin
-     Message(exec_e_res_not_found);
-     aktglobalswitches:=aktglobalswitches+[cs_link_extern];
-   end;
-{$IFDEF USE_SYSUTILS}
-  srcfilepath := SplitPath(current_module.mainsource^);
-{$ELSE USE_SYSUTILS}
-  fsplit(current_module.mainsource^,srcfilepath,n,e);
-{$ENDIF USE_SYSUTILS}
-  if not path_absolute(fname) then
-    fname:=srcfilepath+fname;
-  resobj:=ForceExtension(fname,target_info.resobjext);
-  s:=target_res.rescmd;
-  ObjUsed:=(pos('$OBJ',s)>0);
-  Replace(s,'$OBJ',maybequoted(resobj));
-  Replace(s,'$RES',maybequoted(fname));
-  { windres doesn't like empty include paths }
-  if respath='' then
-    respath:='.';
-  Replace(s,'$INC',maybequoted(respath));
-  if (target_info.system = system_i386_win32) and
-     (srcfilepath<>'') then
-    s:=s+' --include '+maybequoted(srcfilepath);
-{ Execute the command }
-  if not (cs_link_extern in aktglobalswitches) then
-   begin
-     Message1(exec_i_compilingresource,fname);
-     Message2(exec_d_resbin_params,resbin,s);
-{$IFDEF USE_SYSUTILS}
-     try
-       if ExecuteProcess(resbin,s) <> 0 then
-       begin
-         Message(exec_e_error_while_linking);
-         aktglobalswitches:=aktglobalswitches+[cs_link_extern];
-       end;
-     except
-       on E:EOSError do
-       begin
-         Message(exec_e_cant_call_linker);
-         aktglobalswitches:=aktglobalswitches+[cs_link_extern];
-       end
-     end;
-{$ELSE USE_SYSUTILS}
-     swapvectors;
-     exec(resbin,s);
-     swapvectors;
-     if (doserror<>0) then
-      begin
-        Message(exec_e_cant_call_linker);
-        aktglobalswitches:=aktglobalswitches+[cs_link_extern];
-      end
-     else
-      if (dosexitcode<>0) then
-       begin
-         Message(exec_e_error_while_linking);
-         aktglobalswitches:=aktglobalswitches+[cs_link_extern];
-       end;
-{$ENDIF USE_SYSUTILS}
-    end;
-  { Update asmres when externmode is set }
-  if cs_link_extern in aktglobalswitches then
-    AsmRes.AddLinkCommand(resbin,s,'');
-  if ObjUsed then
-    current_module.linkotherofiles.add(resobj,link_allways);
-end;
-
-
-procedure CompileResourceFiles;
-var
-  hr : presourcefile;
-begin
-  { OS/2 (EMX) must be processed elsewhere (in the linking/binding stage).
-    same with MacOS}
-  if not (target_info.system in [system_i386_os2,
-                                 system_i386_emx,system_powerpc_macos]) then
-   While not current_module.ResourceFiles.Empty do
-     begin
-       if target_info.res<>res_none then
-         begin
-           hr:=new(presourcefile,init(current_module.ResourceFiles.getfirst));
-           hr^.compile;
-           dispose(hr,done);
-         end
-       else
-         Message(scan_e_resourcefiles_not_supported);
-     end;
-end;
-
-
-end.

compiler/compiler/cp437.pas

@@ -1,281 +0,0 @@
-{ This is an automatically created file, so don't edit it }
-unit cp437;
-
-  interface
-
-  implementation
-
-  uses
-     charset;
-
-  const
-     map : array[0..255] of tunicodecharmapping = (
-       (unicode : 0; flag : umf_noinfo; reserved : 0),
-       (unicode : 1; flag : umf_noinfo; reserved : 0),
-       (unicode : 2; flag : umf_noinfo; reserved : 0),
-       (unicode : 3; flag : umf_noinfo; reserved : 0),
-       (unicode : 4; flag : umf_noinfo; reserved : 0),
-       (unicode : 5; flag : umf_noinfo; reserved : 0),
-       (unicode : 6; flag : umf_noinfo; reserved : 0),
-       (unicode : 7; flag : umf_noinfo; reserved : 0),
-       (unicode : 8; flag : umf_noinfo; reserved : 0),
-       (unicode : 9; flag : umf_noinfo; reserved : 0),
-       (unicode : 10; flag : umf_noinfo; reserved : 0),
-       (unicode : 11; flag : umf_noinfo; reserved : 0),
-       (unicode : 12; flag : umf_noinfo; reserved : 0),
-       (unicode : 13; flag : umf_noinfo; reserved : 0),
-       (unicode : 14; flag : umf_noinfo; reserved : 0),
-       (unicode : 15; flag : umf_noinfo; reserved : 0),
-       (unicode : 16; flag : umf_noinfo; reserved : 0),
-       (unicode : 17; flag : umf_noinfo; reserved : 0),
-       (unicode : 18; flag : umf_noinfo; reserved : 0),
-       (unicode : 19; flag : umf_noinfo; reserved : 0),
-       (unicode : 20; flag : umf_noinfo; reserved : 0),
-       (unicode : 21; flag : umf_noinfo; reserved : 0),
-       (unicode : 22; flag : umf_noinfo; reserved : 0),
-       (unicode : 23; flag : umf_noinfo; reserved : 0),
-       (unicode : 24; flag : umf_noinfo; reserved : 0),
-       (unicode : 25; flag : umf_noinfo; reserved : 0),
-       (unicode : 26; flag : umf_noinfo; reserved : 0),
-       (unicode : 27; flag : umf_noinfo; reserved : 0),
-       (unicode : 28; flag : umf_noinfo; reserved : 0),
-       (unicode : 29; flag : umf_noinfo; reserved : 0),
-       (unicode : 30; flag : umf_noinfo; reserved : 0),
-       (unicode : 31; flag : umf_noinfo; reserved : 0),
-       (unicode : 32; flag : umf_noinfo; reserved : 0),
-       (unicode : 33; flag : umf_noinfo; reserved : 0),
-       (unicode : 34; flag : umf_noinfo; reserved : 0),
-       (unicode : 35; flag : umf_noinfo; reserved : 0),
-       (unicode : 36; flag : umf_noinfo; reserved : 0),
-       (unicode : 37; flag : umf_noinfo; reserved : 0),
-       (unicode : 38; flag : umf_noinfo; reserved : 0),
-       (unicode : 39; flag : umf_noinfo; reserved : 0),
-       (unicode : 40; flag : umf_noinfo; reserved : 0),
-       (unicode : 41; flag : umf_noinfo; reserved : 0),
-       (unicode : 42; flag : umf_noinfo; reserved : 0),
-       (unicode : 43; flag : umf_noinfo; reserved : 0),
-       (unicode : 44; flag : umf_noinfo; reserved : 0),
-       (unicode : 45; flag : umf_noinfo; reserved : 0),
-       (unicode : 46; flag : umf_noinfo; reserved : 0),
-       (unicode : 47; flag : umf_noinfo; reserved : 0),
-       (unicode : 48; flag : umf_noinfo; reserved : 0),
-       (unicode : 49; flag : umf_noinfo; reserved : 0),
-       (unicode : 50; flag : umf_noinfo; reserved : 0),
-       (unicode : 51; flag : umf_noinfo; reserved : 0),
-       (unicode : 52; flag : umf_noinfo; reserved : 0),
-       (unicode : 53; flag : umf_noinfo; reserved : 0),
-       (unicode : 54; flag : umf_noinfo; reserved : 0),
-       (unicode : 55; flag : umf_noinfo; reserved : 0),
-       (unicode : 56; flag : umf_noinfo; reserved : 0),
-       (unicode : 57; flag : umf_noinfo; reserved : 0),
-       (unicode : 58; flag : umf_noinfo; reserved : 0),
-       (unicode : 59; flag : umf_noinfo; reserved : 0),
-       (unicode : 60; flag : umf_noinfo; reserved : 0),
-       (unicode : 61; flag : umf_noinfo; reserved : 0),
-       (unicode : 62; flag : umf_noinfo; reserved : 0),
-       (unicode : 63; flag : umf_noinfo; reserved : 0),
-       (unicode : 64; flag : umf_noinfo; reserved : 0),
-       (unicode : 65; flag : umf_noinfo; reserved : 0),
-       (unicode : 66; flag : umf_noinfo; reserved : 0),
-       (unicode : 67; flag : umf_noinfo; reserved : 0),
-       (unicode : 68; flag : umf_noinfo; reserved : 0),
-       (unicode : 69; flag : umf_noinfo; reserved : 0),
-       (unicode : 70; flag : umf_noinfo; reserved : 0),
-       (unicode : 71; flag : umf_noinfo; reserved : 0),
-       (unicode : 72; flag : umf_noinfo; reserved : 0),
-       (unicode : 73; flag : umf_noinfo; reserved : 0),
-       (unicode : 74; flag : umf_noinfo; reserved : 0),
-       (unicode : 75; flag : umf_noinfo; reserved : 0),
-       (unicode : 76; flag : umf_noinfo; reserved : 0),
-       (unicode : 77; flag : umf_noinfo; reserved : 0),
-       (unicode : 78; flag : umf_noinfo; reserved : 0),
-       (unicode : 79; flag : umf_noinfo; reserved : 0),
-       (unicode : 80; flag : umf_noinfo; reserved : 0),
-       (unicode : 81; flag : umf_noinfo; reserved : 0),
-       (unicode : 82; flag : umf_noinfo; reserved : 0),
-       (unicode : 83; flag : umf_noinfo; reserved : 0),
-       (unicode : 84; flag : umf_noinfo; reserved : 0),
-       (unicode : 85; flag : umf_noinfo; reserved : 0),
-       (unicode : 86; flag : umf_noinfo; reserved : 0),
-       (unicode : 87; flag : umf_noinfo; reserved : 0),
-       (unicode : 88; flag : umf_noinfo; reserved : 0),
-       (unicode : 89; flag : umf_noinfo; reserved : 0),
-       (unicode : 90; flag : umf_noinfo; reserved : 0),
-       (unicode : 91; flag : umf_noinfo; reserved : 0),
-       (unicode : 92; flag : umf_noinfo; reserved : 0),
-       (unicode : 93; flag : umf_noinfo; reserved : 0),
-       (unicode : 94; flag : umf_noinfo; reserved : 0),
-       (unicode : 95; flag : umf_noinfo; reserved : 0),
-       (unicode : 96; flag : umf_noinfo; reserved : 0),
-       (unicode : 97; flag : umf_noinfo; reserved : 0),
-       (unicode : 98; flag : umf_noinfo; reserved : 0),
-       (unicode : 99; flag : umf_noinfo; reserved : 0),
-       (unicode : 100; flag : umf_noinfo; reserved : 0),
-       (unicode : 101; flag : umf_noinfo; reserved : 0),
-       (unicode : 102; flag : umf_noinfo; reserved : 0),
-       (unicode : 103; flag : umf_noinfo; reserved : 0),
-       (unicode : 104; flag : umf_noinfo; reserved : 0),
-       (unicode : 105; flag : umf_noinfo; reserved : 0),
-       (unicode : 106; flag : umf_noinfo; reserved : 0),
-       (unicode : 107; flag : umf_noinfo; reserved : 0),
-       (unicode : 108; flag : umf_noinfo; reserved : 0),
-       (unicode : 109; flag : umf_noinfo; reserved : 0),
-       (unicode : 110; flag : umf_noinfo; reserved : 0),
-       (unicode : 111; flag : umf_noinfo; reserved : 0),
-       (unicode : 112; flag : umf_noinfo; reserved : 0),
-       (unicode : 113; flag : umf_noinfo; reserved : 0),
-       (unicode : 114; flag : umf_noinfo; reserved : 0),
-       (unicode : 115; flag : umf_noinfo; reserved : 0),
-       (unicode : 116; flag : umf_noinfo; reserved : 0),
-       (unicode : 117; flag : umf_noinfo; reserved : 0),
-       (unicode : 118; flag : umf_noinfo; reserved : 0),
-       (unicode : 119; flag : umf_noinfo; reserved : 0),
-       (unicode : 120; flag : umf_noinfo; reserved : 0),
-       (unicode : 121; flag : umf_noinfo; reserved : 0),
-       (unicode : 122; flag : umf_noinfo; reserved : 0),
-       (unicode : 123; flag : umf_noinfo; reserved : 0),
-       (unicode : 124; flag : umf_noinfo; reserved : 0),
-       (unicode : 125; flag : umf_noinfo; reserved : 0),
-       (unicode : 126; flag : umf_noinfo; reserved : 0),
-       (unicode : 127; flag : umf_noinfo; reserved : 0),
-       (unicode : 199; flag : umf_noinfo; reserved : 0),
-       (unicode : 252; flag : umf_noinfo; reserved : 0),
-       (unicode : 233; flag : umf_noinfo; reserved : 0),
-       (unicode : 226; flag : umf_noinfo; reserved : 0),
-       (unicode : 228; flag : umf_noinfo; reserved : 0),
-       (unicode : 224; flag : umf_noinfo; reserved : 0),
-       (unicode : 229; flag : umf_noinfo; reserved : 0),
-       (unicode : 231; flag : umf_noinfo; reserved : 0),
-       (unicode : 234; flag : umf_noinfo; reserved : 0),
-       (unicode : 235; flag : umf_noinfo; reserved : 0),
-       (unicode : 232; flag : umf_noinfo; reserved : 0),
-       (unicode : 239; flag : umf_noinfo; reserved : 0),
-       (unicode : 238; flag : umf_noinfo; reserved : 0),
-       (unicode : 236; flag : umf_noinfo; reserved : 0),
-       (unicode : 196; flag : umf_noinfo; reserved : 0),
-       (unicode : 197; flag : umf_noinfo; reserved : 0),
-       (unicode : 201; flag : umf_noinfo; reserved : 0),
-       (unicode : 230; flag : umf_noinfo; reserved : 0),
-       (unicode : 198; flag : umf_noinfo; reserved : 0),
-       (unicode : 244; flag : umf_noinfo; reserved : 0),
-       (unicode : 246; flag : umf_noinfo; reserved : 0),
-       (unicode : 242; flag : umf_noinfo; reserved : 0),
-       (unicode : 251; flag : umf_noinfo; reserved : 0),
-       (unicode : 249; flag : umf_noinfo; reserved : 0),
-       (unicode : 255; flag : umf_noinfo; reserved : 0),
-       (unicode : 214; flag : umf_noinfo; reserved : 0),
-       (unicode : 220; flag : umf_noinfo; reserved : 0),
-       (unicode : 162; flag : umf_noinfo; reserved : 0),
-       (unicode : 163; flag : umf_noinfo; reserved : 0),
-       (unicode : 165; flag : umf_noinfo; reserved : 0),
-       (unicode : 8359; flag : umf_noinfo; reserved : 0),
-       (unicode : 402; flag : umf_noinfo; reserved : 0),
-       (unicode : 225; flag : umf_noinfo; reserved : 0),
-       (unicode : 237; flag : umf_noinfo; reserved : 0),
-       (unicode : 243; flag : umf_noinfo; reserved : 0),
-       (unicode : 250; flag : umf_noinfo; reserved : 0),
-       (unicode : 241; flag : umf_noinfo; reserved : 0),
-       (unicode : 209; flag : umf_noinfo; reserved : 0),
-       (unicode : 170; flag : umf_noinfo; reserved : 0),
-       (unicode : 186; flag : umf_noinfo; reserved : 0),
-       (unicode : 191; flag : umf_noinfo; reserved : 0),
-       (unicode : 8976; flag : umf_noinfo; reserved : 0),
-       (unicode : 172; flag : umf_noinfo; reserved : 0),
-       (unicode : 189; flag : umf_noinfo; reserved : 0),
-       (unicode : 188; flag : umf_noinfo; reserved : 0),
-       (unicode : 161; flag : umf_noinfo; reserved : 0),
-       (unicode : 171; flag : umf_noinfo; reserved : 0),
-       (unicode : 187; flag : umf_noinfo; reserved : 0),
-       (unicode : 9617; flag : umf_noinfo; reserved : 0),
-       (unicode : 9618; flag : umf_noinfo; reserved : 0),
-       (unicode : 9619; flag : umf_noinfo; reserved : 0),
-       (unicode : 9474; flag : umf_noinfo; reserved : 0),
-       (unicode : 9508; flag : umf_noinfo; reserved : 0),
-       (unicode : 9569; flag : umf_noinfo; reserved : 0),
-       (unicode : 9570; flag : umf_noinfo; reserved : 0),
-       (unicode : 9558; flag : umf_noinfo; reserved : 0),
-       (unicode : 9557; flag : umf_noinfo; reserved : 0),
-       (unicode : 9571; flag : umf_noinfo; reserved : 0),
-       (unicode : 9553; flag : umf_noinfo; reserved : 0),
-       (unicode : 9559; flag : umf_noinfo; reserved : 0),
-       (unicode : 9565; flag : umf_noinfo; reserved : 0),
-       (unicode : 9564; flag : umf_noinfo; reserved : 0),
-       (unicode : 9563; flag : umf_noinfo; reserved : 0),
-       (unicode : 9488; flag : umf_noinfo; reserved : 0),
-       (unicode : 9492; flag : umf_noinfo; reserved : 0),
-       (unicode : 9524; flag : umf_noinfo; reserved : 0),
-       (unicode : 9516; flag : umf_noinfo; reserved : 0),
-       (unicode : 9500; flag : umf_noinfo; reserved : 0),
-       (unicode : 9472; flag : umf_noinfo; reserved : 0),
-       (unicode : 9532; flag : umf_noinfo; reserved : 0),
-       (unicode : 9566; flag : umf_noinfo; reserved : 0),
-       (unicode : 9567; flag : umf_noinfo; reserved : 0),
-       (unicode : 9562; flag : umf_noinfo; reserved : 0),
-       (unicode : 9556; flag : umf_noinfo; reserved : 0),
-       (unicode : 9577; flag : umf_noinfo; reserved : 0),
-       (unicode : 9574; flag : umf_noinfo; reserved : 0),
-       (unicode : 9568; flag : umf_noinfo; reserved : 0),
-       (unicode : 9552; flag : umf_noinfo; reserved : 0),
-       (unicode : 9580; flag : umf_noinfo; reserved : 0),
-       (unicode : 9575; flag : umf_noinfo; reserved : 0),
-       (unicode : 9576; flag : umf_noinfo; reserved : 0),
-       (unicode : 9572; flag : umf_noinfo; reserved : 0),
-       (unicode : 9573; flag : umf_noinfo; reserved : 0),
-       (unicode : 9561; flag : umf_noinfo; reserved : 0),
-       (unicode : 9560; flag : umf_noinfo; reserved : 0),
-       (unicode : 9554; flag : umf_noinfo; reserved : 0),
-       (unicode : 9555; flag : umf_noinfo; reserved : 0),
-       (unicode : 9579; flag : umf_noinfo; reserved : 0),
-       (unicode : 9578; flag : umf_noinfo; reserved : 0),
-       (unicode : 9496; flag : umf_noinfo; reserved : 0),
-       (unicode : 9484; flag : umf_noinfo; reserved : 0),
-       (unicode : 9608; flag : umf_noinfo; reserved : 0),
-       (unicode : 9604; flag : umf_noinfo; reserved : 0),
-       (unicode : 9612; flag : umf_noinfo; reserved : 0),
-       (unicode : 9616; flag : umf_noinfo; reserved : 0),
-       (unicode : 9600; flag : umf_noinfo; reserved : 0),
-       (unicode : 945; flag : umf_noinfo; reserved : 0),
-       (unicode : 223; flag : umf_noinfo; reserved : 0),
-       (unicode : 915; flag : umf_noinfo; reserved : 0),
-       (unicode : 960; flag : umf_noinfo; reserved : 0),
-       (unicode : 931; flag : umf_noinfo; reserved : 0),
-       (unicode : 963; flag : umf_noinfo; reserved : 0),
-       (unicode : 181; flag : umf_noinfo; reserved : 0),
-       (unicode : 964; flag : umf_noinfo; reserved : 0),
-       (unicode : 934; flag : umf_noinfo; reserved : 0),
-       (unicode : 920; flag : umf_noinfo; reserved : 0),
-       (unicode : 937; flag : umf_noinfo; reserved : 0),
-       (unicode : 948; flag : umf_noinfo; reserved : 0),
-       (unicode : 8734; flag : umf_noinfo; reserved : 0),
-       (unicode : 966; flag : umf_noinfo; reserved : 0),
-       (unicode : 949; flag : umf_noinfo; reserved : 0),
-       (unicode : 8745; flag : umf_noinfo; reserved : 0),
-       (unicode : 8801; flag : umf_noinfo; reserved : 0),
-       (unicode : 177; flag : umf_noinfo; reserved : 0),
-       (unicode : 8805; flag : umf_noinfo; reserved : 0),
-       (unicode : 8804; flag : umf_noinfo; reserved : 0),
-       (unicode : 8992; flag : umf_noinfo; reserved : 0),
-       (unicode : 8993; flag : umf_noinfo; reserved : 0),
-       (unicode : 247; flag : umf_noinfo; reserved : 0),
-       (unicode : 8776; flag : umf_noinfo; reserved : 0),
-       (unicode : 176; flag : umf_noinfo; reserved : 0),
-       (unicode : 8729; flag : umf_noinfo; reserved : 0),
-       (unicode : 183; flag : umf_noinfo; reserved : 0),
-       (unicode : 8730; flag : umf_noinfo; reserved : 0),
-       (unicode : 8319; flag : umf_noinfo; reserved : 0),
-       (unicode : 178; flag : umf_noinfo; reserved : 0),
-       (unicode : 9632; flag : umf_noinfo; reserved : 0),
-       (unicode : 160; flag : umf_noinfo; reserved : 0)
-     );
-
-     unicodemap : tunicodemap = (
-       cpname : 'cp437';
-       map : @map;
-       lastchar : 255;
-       next : nil;
-       internalmap : true
-     );
-
-  begin
-     registermapping(@unicodemap)
-  end.

compiler/compiler/cp850.pas

@@ -1,281 +0,0 @@
-{ This is an automatically created file, so don't edit it }
-unit cp850;
-
-  interface
-
-  implementation
-
-  uses
-     charset;
-
-  const
-     map : array[0..255] of tunicodecharmapping = (
-       (unicode : 0; flag : umf_noinfo; reserved : 0),
-       (unicode : 1; flag : umf_noinfo; reserved : 0),
-       (unicode : 2; flag : umf_noinfo; reserved : 0),
-       (unicode : 3; flag : umf_noinfo; reserved : 0),
-       (unicode : 4; flag : umf_noinfo; reserved : 0),
-       (unicode : 5; flag : umf_noinfo; reserved : 0),
-       (unicode : 6; flag : umf_noinfo; reserved : 0),
-       (unicode : 7; flag : umf_noinfo; reserved : 0),
-       (unicode : 8; flag : umf_noinfo; reserved : 0),
-       (unicode : 9; flag : umf_noinfo; reserved : 0),
-       (unicode : 10; flag : umf_noinfo; reserved : 0),
-       (unicode : 11; flag : umf_noinfo; reserved : 0),
-       (unicode : 12; flag : umf_noinfo; reserved : 0),
-       (unicode : 13; flag : umf_noinfo; reserved : 0),
-       (unicode : 14; flag : umf_noinfo; reserved : 0),
-       (unicode : 15; flag : umf_noinfo; reserved : 0),
-       (unicode : 16; flag : umf_noinfo; reserved : 0),
-       (unicode : 17; flag : umf_noinfo; reserved : 0),
-       (unicode : 18; flag : umf_noinfo; reserved : 0),
-       (unicode : 19; flag : umf_noinfo; reserved : 0),
-       (unicode : 20; flag : umf_noinfo; reserved : 0),
-       (unicode : 21; flag : umf_noinfo; reserved : 0),
-       (unicode : 22; flag : umf_noinfo; reserved : 0),
-       (unicode : 23; flag : umf_noinfo; reserved : 0),
-       (unicode : 24; flag : umf_noinfo; reserved : 0),
-       (unicode : 25; flag : umf_noinfo; reserved : 0),
-       (unicode : 26; flag : umf_noinfo; reserved : 0),
-       (unicode : 27; flag : umf_noinfo; reserved : 0),
-       (unicode : 28; flag : umf_noinfo; reserved : 0),
-       (unicode : 29; flag : umf_noinfo; reserved : 0),
-       (unicode : 30; flag : umf_noinfo; reserved : 0),
-       (unicode : 31; flag : umf_noinfo; reserved : 0),
-       (unicode : 32; flag : umf_noinfo; reserved : 0),
-       (unicode : 33; flag : umf_noinfo; reserved : 0),
-       (unicode : 34; flag : umf_noinfo; reserved : 0),
-       (unicode : 35; flag : umf_noinfo; reserved : 0),
-       (unicode : 36; flag : umf_noinfo; reserved : 0),
-       (unicode : 37; flag : umf_noinfo; reserved : 0),
-       (unicode : 38; flag : umf_noinfo; reserved : 0),
-       (unicode : 39; flag : umf_noinfo; reserved : 0),
-       (unicode : 40; flag : umf_noinfo; reserved : 0),
-       (unicode : 41; flag : umf_noinfo; reserved : 0),
-       (unicode : 42; flag : umf_noinfo; reserved : 0),
-       (unicode : 43; flag : umf_noinfo; reserved : 0),
-       (unicode : 44; flag : umf_noinfo; reserved : 0),
-       (unicode : 45; flag : umf_noinfo; reserved : 0),
-       (unicode : 46; flag : umf_noinfo; reserved : 0),
-       (unicode : 47; flag : umf_noinfo; reserved : 0),
-       (unicode : 48; flag : umf_noinfo; reserved : 0),
-       (unicode : 49; flag : umf_noinfo; reserved : 0),
-       (unicode : 50; flag : umf_noinfo; reserved : 0),
-       (unicode : 51; flag : umf_noinfo; reserved : 0),
-       (unicode : 52; flag : umf_noinfo; reserved : 0),
-       (unicode : 53; flag : umf_noinfo; reserved : 0),
-       (unicode : 54; flag : umf_noinfo; reserved : 0),
-       (unicode : 55; flag : umf_noinfo; reserved : 0),
-       (unicode : 56; flag : umf_noinfo; reserved : 0),
-       (unicode : 57; flag : umf_noinfo; reserved : 0),
-       (unicode : 58; flag : umf_noinfo; reserved : 0),
-       (unicode : 59; flag : umf_noinfo; reserved : 0),
-       (unicode : 60; flag : umf_noinfo; reserved : 0),
-       (unicode : 61; flag : umf_noinfo; reserved : 0),
-       (unicode : 62; flag : umf_noinfo; reserved : 0),
-       (unicode : 63; flag : umf_noinfo; reserved : 0),
-       (unicode : 64; flag : umf_noinfo; reserved : 0),
-       (unicode : 65; flag : umf_noinfo; reserved : 0),
-       (unicode : 66; flag : umf_noinfo; reserved : 0),
-       (unicode : 67; flag : umf_noinfo; reserved : 0),
-       (unicode : 68; flag : umf_noinfo; reserved : 0),
-       (unicode : 69; flag : umf_noinfo; reserved : 0),
-       (unicode : 70; flag : umf_noinfo; reserved : 0),
-       (unicode : 71; flag : umf_noinfo; reserved : 0),
-       (unicode : 72; flag : umf_noinfo; reserved : 0),
-       (unicode : 73; flag : umf_noinfo; reserved : 0),
-       (unicode : 74; flag : umf_noinfo; reserved : 0),
-       (unicode : 75; flag : umf_noinfo; reserved : 0),
-       (unicode : 76; flag : umf_noinfo; reserved : 0),
-       (unicode : 77; flag : umf_noinfo; reserved : 0),
-       (unicode : 78; flag : umf_noinfo; reserved : 0),
-       (unicode : 79; flag : umf_noinfo; reserved : 0),
-       (unicode : 80; flag : umf_noinfo; reserved : 0),
-       (unicode : 81; flag : umf_noinfo; reserved : 0),
-       (unicode : 82; flag : umf_noinfo; reserved : 0),
-       (unicode : 83; flag : umf_noinfo; reserved : 0),
-       (unicode : 84; flag : umf_noinfo; reserved : 0),
-       (unicode : 85; flag : umf_noinfo; reserved : 0),
-       (unicode : 86; flag : umf_noinfo; reserved : 0),
-       (unicode : 87; flag : umf_noinfo; reserved : 0),
-       (unicode : 88; flag : umf_noinfo; reserved : 0),
-       (unicode : 89; flag : umf_noinfo; reserved : 0),
-       (unicode : 90; flag : umf_noinfo; reserved : 0),
-       (unicode : 91; flag : umf_noinfo; reserved : 0),
-       (unicode : 92; flag : umf_noinfo; reserved : 0),
-       (unicode : 93; flag : umf_noinfo; reserved : 0),
-       (unicode : 94; flag : umf_noinfo; reserved : 0),
-       (unicode : 95; flag : umf_noinfo; reserved : 0),
-       (unicode : 96; flag : umf_noinfo; reserved : 0),
-       (unicode : 97; flag : umf_noinfo; reserved : 0),
-       (unicode : 98; flag : umf_noinfo; reserved : 0),
-       (unicode : 99; flag : umf_noinfo; reserved : 0),
-       (unicode : 100; flag : umf_noinfo; reserved : 0),
-       (unicode : 101; flag : umf_noinfo; reserved : 0),
-       (unicode : 102; flag : umf_noinfo; reserved : 0),
-       (unicode : 103; flag : umf_noinfo; reserved : 0),
-       (unicode : 104; flag : umf_noinfo; reserved : 0),
-       (unicode : 105; flag : umf_noinfo; reserved : 0),
-       (unicode : 106; flag : umf_noinfo; reserved : 0),
-       (unicode : 107; flag : umf_noinfo; reserved : 0),
-       (unicode : 108; flag : umf_noinfo; reserved : 0),
-       (unicode : 109; flag : umf_noinfo; reserved : 0),
-       (unicode : 110; flag : umf_noinfo; reserved : 0),
-       (unicode : 111; flag : umf_noinfo; reserved : 0),
-       (unicode : 112; flag : umf_noinfo; reserved : 0),
-       (unicode : 113; flag : umf_noinfo; reserved : 0),
-       (unicode : 114; flag : umf_noinfo; reserved : 0),
-       (unicode : 115; flag : umf_noinfo; reserved : 0),
-       (unicode : 116; flag : umf_noinfo; reserved : 0),
-       (unicode : 117; flag : umf_noinfo; reserved : 0),
-       (unicode : 118; flag : umf_noinfo; reserved : 0),
-       (unicode : 119; flag : umf_noinfo; reserved : 0),
-       (unicode : 120; flag : umf_noinfo; reserved : 0),
-       (unicode : 121; flag : umf_noinfo; reserved : 0),
-       (unicode : 122; flag : umf_noinfo; reserved : 0),
-       (unicode : 123; flag : umf_noinfo; reserved : 0),
-       (unicode : 124; flag : umf_noinfo; reserved : 0),
-       (unicode : 125; flag : umf_noinfo; reserved : 0),
-       (unicode : 126; flag : umf_noinfo; reserved : 0),
-       (unicode : 127; flag : umf_noinfo; reserved : 0),
-       (unicode : 199; flag : umf_noinfo; reserved : 0),
-       (unicode : 252; flag : umf_noinfo; reserved : 0),
-       (unicode : 233; flag : umf_noinfo; reserved : 0),
-       (unicode : 226; flag : umf_noinfo; reserved : 0),
-       (unicode : 228; flag : umf_noinfo; reserved : 0),
-       (unicode : 224; flag : umf_noinfo; reserved : 0),
-       (unicode : 229; flag : umf_noinfo; reserved : 0),
-       (unicode : 231; flag : umf_noinfo; reserved : 0),
-       (unicode : 234; flag : umf_noinfo; reserved : 0),
-       (unicode : 235; flag : umf_noinfo; reserved : 0),
-       (unicode : 232; flag : umf_noinfo; reserved : 0),
-       (unicode : 239; flag : umf_noinfo; reserved : 0),
-       (unicode : 238; flag : umf_noinfo; reserved : 0),
-       (unicode : 236; flag : umf_noinfo; reserved : 0),
-       (unicode : 196; flag : umf_noinfo; reserved : 0),
-       (unicode : 197; flag : umf_noinfo; reserved : 0),
-       (unicode : 201; flag : umf_noinfo; reserved : 0),
-       (unicode : 230; flag : umf_noinfo; reserved : 0),
-       (unicode : 198; flag : umf_noinfo; reserved : 0),
-       (unicode : 244; flag : umf_noinfo; reserved : 0),
-       (unicode : 246; flag : umf_noinfo; reserved : 0),
-       (unicode : 242; flag : umf_noinfo; reserved : 0),
-       (unicode : 251; flag : umf_noinfo; reserved : 0),
-       (unicode : 249; flag : umf_noinfo; reserved : 0),
-       (unicode : 255; flag : umf_noinfo; reserved : 0),
-       (unicode : 214; flag : umf_noinfo; reserved : 0),
-       (unicode : 220; flag : umf_noinfo; reserved : 0),
-       (unicode : 248; flag : umf_noinfo; reserved : 0),
-       (unicode : 163; flag : umf_noinfo; reserved : 0),
-       (unicode : 216; flag : umf_noinfo; reserved : 0),
-       (unicode : 215; flag : umf_noinfo; reserved : 0),
-       (unicode : 402; flag : umf_noinfo; reserved : 0),
-       (unicode : 225; flag : umf_noinfo; reserved : 0),
-       (unicode : 237; flag : umf_noinfo; reserved : 0),
-       (unicode : 243; flag : umf_noinfo; reserved : 0),
-       (unicode : 250; flag : umf_noinfo; reserved : 0),
-       (unicode : 241; flag : umf_noinfo; reserved : 0),
-       (unicode : 209; flag : umf_noinfo; reserved : 0),
-       (unicode : 170; flag : umf_noinfo; reserved : 0),
-       (unicode : 186; flag : umf_noinfo; reserved : 0),
-       (unicode : 191; flag : umf_noinfo; reserved : 0),
-       (unicode : 174; flag : umf_noinfo; reserved : 0),
-       (unicode : 172; flag : umf_noinfo; reserved : 0),
-       (unicode : 189; flag : umf_noinfo; reserved : 0),
-       (unicode : 188; flag : umf_noinfo; reserved : 0),
-       (unicode : 161; flag : umf_noinfo; reserved : 0),
-       (unicode : 171; flag : umf_noinfo; reserved : 0),
-       (unicode : 187; flag : umf_noinfo; reserved : 0),
-       (unicode : 9617; flag : umf_noinfo; reserved : 0),
-       (unicode : 9618; flag : umf_noinfo; reserved : 0),
-       (unicode : 9619; flag : umf_noinfo; reserved : 0),
-       (unicode : 9474; flag : umf_noinfo; reserved : 0),
-       (unicode : 9508; flag : umf_noinfo; reserved : 0),
-       (unicode : 193; flag : umf_noinfo; reserved : 0),
-       (unicode : 194; flag : umf_noinfo; reserved : 0),
-       (unicode : 192; flag : umf_noinfo; reserved : 0),
-       (unicode : 169; flag : umf_noinfo; reserved : 0),
-       (unicode : 9571; flag : umf_noinfo; reserved : 0),
-       (unicode : 9553; flag : umf_noinfo; reserved : 0),
-       (unicode : 9559; flag : umf_noinfo; reserved : 0),
-       (unicode : 9565; flag : umf_noinfo; reserved : 0),
-       (unicode : 162; flag : umf_noinfo; reserved : 0),
-       (unicode : 165; flag : umf_noinfo; reserved : 0),
-       (unicode : 9488; flag : umf_noinfo; reserved : 0),
-       (unicode : 9492; flag : umf_noinfo; reserved : 0),
-       (unicode : 9524; flag : umf_noinfo; reserved : 0),
-       (unicode : 9516; flag : umf_noinfo; reserved : 0),
-       (unicode : 9500; flag : umf_noinfo; reserved : 0),
-       (unicode : 9472; flag : umf_noinfo; reserved : 0),
-       (unicode : 9532; flag : umf_noinfo; reserved : 0),
-       (unicode : 227; flag : umf_noinfo; reserved : 0),
-       (unicode : 195; flag : umf_noinfo; reserved : 0),
-       (unicode : 9562; flag : umf_noinfo; reserved : 0),
-       (unicode : 9556; flag : umf_noinfo; reserved : 0),
-       (unicode : 9577; flag : umf_noinfo; reserved : 0),
-       (unicode : 9574; flag : umf_noinfo; reserved : 0),
-       (unicode : 9568; flag : umf_noinfo; reserved : 0),
-       (unicode : 9552; flag : umf_noinfo; reserved : 0),
-       (unicode : 9580; flag : umf_noinfo; reserved : 0),
-       (unicode : 164; flag : umf_noinfo; reserved : 0),
-       (unicode : 240; flag : umf_noinfo; reserved : 0),
-       (unicode : 208; flag : umf_noinfo; reserved : 0),
-       (unicode : 202; flag : umf_noinfo; reserved : 0),
-       (unicode : 203; flag : umf_noinfo; reserved : 0),
-       (unicode : 200; flag : umf_noinfo; reserved : 0),
-       (unicode : 305; flag : umf_noinfo; reserved : 0),
-       (unicode : 205; flag : umf_noinfo; reserved : 0),
-       (unicode : 206; flag : umf_noinfo; reserved : 0),
-       (unicode : 207; flag : umf_noinfo; reserved : 0),
-       (unicode : 9496; flag : umf_noinfo; reserved : 0),
-       (unicode : 9484; flag : umf_noinfo; reserved : 0),
-       (unicode : 9608; flag : umf_noinfo; reserved : 0),
-       (unicode : 9604; flag : umf_noinfo; reserved : 0),
-       (unicode : 166; flag : umf_noinfo; reserved : 0),
-       (unicode : 204; flag : umf_noinfo; reserved : 0),
-       (unicode : 9600; flag : umf_noinfo; reserved : 0),
-       (unicode : 211; flag : umf_noinfo; reserved : 0),
-       (unicode : 223; flag : umf_noinfo; reserved : 0),
-       (unicode : 212; flag : umf_noinfo; reserved : 0),
-       (unicode : 210; flag : umf_noinfo; reserved : 0),
-       (unicode : 245; flag : umf_noinfo; reserved : 0),
-       (unicode : 213; flag : umf_noinfo; reserved : 0),
-       (unicode : 181; flag : umf_noinfo; reserved : 0),
-       (unicode : 254; flag : umf_noinfo; reserved : 0),
-       (unicode : 222; flag : umf_noinfo; reserved : 0),
-       (unicode : 218; flag : umf_noinfo; reserved : 0),
-       (unicode : 219; flag : umf_noinfo; reserved : 0),
-       (unicode : 217; flag : umf_noinfo; reserved : 0),
-       (unicode : 253; flag : umf_noinfo; reserved : 0),
-       (unicode : 221; flag : umf_noinfo; reserved : 0),
-       (unicode : 175; flag : umf_noinfo; reserved : 0),
-       (unicode : 180; flag : umf_noinfo; reserved : 0),
-       (unicode : 173; flag : umf_noinfo; reserved : 0),
-       (unicode : 177; flag : umf_noinfo; reserved : 0),
-       (unicode : 8215; flag : umf_noinfo; reserved : 0),
-       (unicode : 190; flag : umf_noinfo; reserved : 0),
-       (unicode : 182; flag : umf_noinfo; reserved : 0),
-       (unicode : 167; flag : umf_noinfo; reserved : 0),
-       (unicode : 247; flag : umf_noinfo; reserved : 0),
-       (unicode : 184; flag : umf_noinfo; reserved : 0),
-       (unicode : 176; flag : umf_noinfo; reserved : 0),
-       (unicode : 168; flag : umf_noinfo; reserved : 0),
-       (unicode : 183; flag : umf_noinfo; reserved : 0),
-       (unicode : 185; flag : umf_noinfo; reserved : 0),
-       (unicode : 179; flag : umf_noinfo; reserved : 0),
-       (unicode : 178; flag : umf_noinfo; reserved : 0),
-       (unicode : 9632; flag : umf_noinfo; reserved : 0),
-       (unicode : 160; flag : umf_noinfo; reserved : 0)
-     );
-
-     unicodemap : tunicodemap = (
-       cpname : 'cp850';
-       map : @map;
-       lastchar : 255;
-       next : nil;
-       internalmap : true
-     );
-
-  begin
-     registermapping(@unicodemap)
-  end.

compiler/compiler/cp8859_1.pas

@@ -1,281 +0,0 @@
-{ This is an automatically created file, so don't edit it }
-unit cp8859_1;
-
-  interface
-
-  implementation
-
-  uses
-     charset;
-
-  const
-     map : array[0..255] of tunicodecharmapping = (
-       (unicode : 0; flag : umf_noinfo; reserved : 0),
-       (unicode : 1; flag : umf_noinfo; reserved : 0),
-       (unicode : 2; flag : umf_noinfo; reserved : 0),
-       (unicode : 3; flag : umf_noinfo; reserved : 0),
-       (unicode : 4; flag : umf_noinfo; reserved : 0),
-       (unicode : 5; flag : umf_noinfo; reserved : 0),
-       (unicode : 6; flag : umf_noinfo; reserved : 0),
-       (unicode : 7; flag : umf_noinfo; reserved : 0),
-       (unicode : 8; flag : umf_noinfo; reserved : 0),
-       (unicode : 9; flag : umf_noinfo; reserved : 0),
-       (unicode : 10; flag : umf_noinfo; reserved : 0),
-       (unicode : 11; flag : umf_noinfo; reserved : 0),
-       (unicode : 12; flag : umf_noinfo; reserved : 0),
-       (unicode : 13; flag : umf_noinfo; reserved : 0),
-       (unicode : 14; flag : umf_noinfo; reserved : 0),
-       (unicode : 15; flag : umf_noinfo; reserved : 0),
-       (unicode : 16; flag : umf_noinfo; reserved : 0),
-       (unicode : 17; flag : umf_noinfo; reserved : 0),
-       (unicode : 18; flag : umf_noinfo; reserved : 0),
-       (unicode : 19; flag : umf_noinfo; reserved : 0),
-       (unicode : 20; flag : umf_noinfo; reserved : 0),
-       (unicode : 21; flag : umf_noinfo; reserved : 0),
-       (unicode : 22; flag : umf_noinfo; reserved : 0),
-       (unicode : 23; flag : umf_noinfo; reserved : 0),
-       (unicode : 24; flag : umf_noinfo; reserved : 0),
-       (unicode : 25; flag : umf_noinfo; reserved : 0),
-       (unicode : 26; flag : umf_noinfo; reserved : 0),
-       (unicode : 27; flag : umf_noinfo; reserved : 0),
-       (unicode : 28; flag : umf_noinfo; reserved : 0),
-       (unicode : 29; flag : umf_noinfo; reserved : 0),
-       (unicode : 30; flag : umf_noinfo; reserved : 0),
-       (unicode : 31; flag : umf_noinfo; reserved : 0),
-       (unicode : 32; flag : umf_noinfo; reserved : 0),
-       (unicode : 33; flag : umf_noinfo; reserved : 0),
-       (unicode : 34; flag : umf_noinfo; reserved : 0),
-       (unicode : 35; flag : umf_noinfo; reserved : 0),
-       (unicode : 36; flag : umf_noinfo; reserved : 0),
-       (unicode : 37; flag : umf_noinfo; reserved : 0),
-       (unicode : 38; flag : umf_noinfo; reserved : 0),
-       (unicode : 39; flag : umf_noinfo; reserved : 0),
-       (unicode : 40; flag : umf_noinfo; reserved : 0),
-       (unicode : 41; flag : umf_noinfo; reserved : 0),
-       (unicode : 42; flag : umf_noinfo; reserved : 0),
-       (unicode : 43; flag : umf_noinfo; reserved : 0),
-       (unicode : 44; flag : umf_noinfo; reserved : 0),
-       (unicode : 45; flag : umf_noinfo; reserved : 0),
-       (unicode : 46; flag : umf_noinfo; reserved : 0),
-       (unicode : 47; flag : umf_noinfo; reserved : 0),
-       (unicode : 48; flag : umf_noinfo; reserved : 0),
-       (unicode : 49; flag : umf_noinfo; reserved : 0),
-       (unicode : 50; flag : umf_noinfo; reserved : 0),
-       (unicode : 51; flag : umf_noinfo; reserved : 0),
-       (unicode : 52; flag : umf_noinfo; reserved : 0),
-       (unicode : 53; flag : umf_noinfo; reserved : 0),
-       (unicode : 54; flag : umf_noinfo; reserved : 0),
-       (unicode : 55; flag : umf_noinfo; reserved : 0),
-       (unicode : 56; flag : umf_noinfo; reserved : 0),
-       (unicode : 57; flag : umf_noinfo; reserved : 0),
-       (unicode : 58; flag : umf_noinfo; reserved : 0),
-       (unicode : 59; flag : umf_noinfo; reserved : 0),
-       (unicode : 60; flag : umf_noinfo; reserved : 0),
-       (unicode : 61; flag : umf_noinfo; reserved : 0),
-       (unicode : 62; flag : umf_noinfo; reserved : 0),
-       (unicode : 63; flag : umf_noinfo; reserved : 0),
-       (unicode : 64; flag : umf_noinfo; reserved : 0),
-       (unicode : 65; flag : umf_noinfo; reserved : 0),
-       (unicode : 66; flag : umf_noinfo; reserved : 0),
-       (unicode : 67; flag : umf_noinfo; reserved : 0),
-       (unicode : 68; flag : umf_noinfo; reserved : 0),
-       (unicode : 69; flag : umf_noinfo; reserved : 0),
-       (unicode : 70; flag : umf_noinfo; reserved : 0),
-       (unicode : 71; flag : umf_noinfo; reserved : 0),
-       (unicode : 72; flag : umf_noinfo; reserved : 0),
-       (unicode : 73; flag : umf_noinfo; reserved : 0),
-       (unicode : 74; flag : umf_noinfo; reserved : 0),
-       (unicode : 75; flag : umf_noinfo; reserved : 0),
-       (unicode : 76; flag : umf_noinfo; reserved : 0),
-       (unicode : 77; flag : umf_noinfo; reserved : 0),
-       (unicode : 78; flag : umf_noinfo; reserved : 0),
-       (unicode : 79; flag : umf_noinfo; reserved : 0),
-       (unicode : 80; flag : umf_noinfo; reserved : 0),
-       (unicode : 81; flag : umf_noinfo; reserved : 0),
-       (unicode : 82; flag : umf_noinfo; reserved : 0),
-       (unicode : 83; flag : umf_noinfo; reserved : 0),
-       (unicode : 84; flag : umf_noinfo; reserved : 0),
-       (unicode : 85; flag : umf_noinfo; reserved : 0),
-       (unicode : 86; flag : umf_noinfo; reserved : 0),
-       (unicode : 87; flag : umf_noinfo; reserved : 0),
-       (unicode : 88; flag : umf_noinfo; reserved : 0),
-       (unicode : 89; flag : umf_noinfo; reserved : 0),
-       (unicode : 90; flag : umf_noinfo; reserved : 0),
-       (unicode : 91; flag : umf_noinfo; reserved : 0),
-       (unicode : 92; flag : umf_noinfo; reserved : 0),
-       (unicode : 93; flag : umf_noinfo; reserved : 0),
-       (unicode : 94; flag : umf_noinfo; reserved : 0),
-       (unicode : 95; flag : umf_noinfo; reserved : 0),
-       (unicode : 96; flag : umf_noinfo; reserved : 0),
-       (unicode : 97; flag : umf_noinfo; reserved : 0),
-       (unicode : 98; flag : umf_noinfo; reserved : 0),
-       (unicode : 99; flag : umf_noinfo; reserved : 0),
-       (unicode : 100; flag : umf_noinfo; reserved : 0),
-       (unicode : 101; flag : umf_noinfo; reserved : 0),
-       (unicode : 102; flag : umf_noinfo; reserved : 0),
-       (unicode : 103; flag : umf_noinfo; reserved : 0),
-       (unicode : 104; flag : umf_noinfo; reserved : 0),
-       (unicode : 105; flag : umf_noinfo; reserved : 0),
-       (unicode : 106; flag : umf_noinfo; reserved : 0),
-       (unicode : 107; flag : umf_noinfo; reserved : 0),
-       (unicode : 108; flag : umf_noinfo; reserved : 0),
-       (unicode : 109; flag : umf_noinfo; reserved : 0),
-       (unicode : 110; flag : umf_noinfo; reserved : 0),
-       (unicode : 111; flag : umf_noinfo; reserved : 0),
-       (unicode : 112; flag : umf_noinfo; reserved : 0),
-       (unicode : 113; flag : umf_noinfo; reserved : 0),
-       (unicode : 114; flag : umf_noinfo; reserved : 0),
-       (unicode : 115; flag : umf_noinfo; reserved : 0),
-       (unicode : 116; flag : umf_noinfo; reserved : 0),
-       (unicode : 117; flag : umf_noinfo; reserved : 0),
-       (unicode : 118; flag : umf_noinfo; reserved : 0),
-       (unicode : 119; flag : umf_noinfo; reserved : 0),
-       (unicode : 120; flag : umf_noinfo; reserved : 0),
-       (unicode : 121; flag : umf_noinfo; reserved : 0),
-       (unicode : 122; flag : umf_noinfo; reserved : 0),
-       (unicode : 123; flag : umf_noinfo; reserved : 0),
-       (unicode : 124; flag : umf_noinfo; reserved : 0),
-       (unicode : 125; flag : umf_noinfo; reserved : 0),
-       (unicode : 126; flag : umf_noinfo; reserved : 0),
-       (unicode : 127; flag : umf_noinfo; reserved : 0),
-       (unicode : 128; flag : umf_noinfo; reserved : 0),
-       (unicode : 129; flag : umf_noinfo; reserved : 0),
-       (unicode : 130; flag : umf_noinfo; reserved : 0),
-       (unicode : 131; flag : umf_noinfo; reserved : 0),
-       (unicode : 132; flag : umf_noinfo; reserved : 0),
-       (unicode : 133; flag : umf_noinfo; reserved : 0),
-       (unicode : 134; flag : umf_noinfo; reserved : 0),
-       (unicode : 135; flag : umf_noinfo; reserved : 0),
-       (unicode : 136; flag : umf_noinfo; reserved : 0),
-       (unicode : 137; flag : umf_noinfo; reserved : 0),
-       (unicode : 138; flag : umf_noinfo; reserved : 0),
-       (unicode : 139; flag : umf_noinfo; reserved : 0),
-       (unicode : 140; flag : umf_noinfo; reserved : 0),
-       (unicode : 141; flag : umf_noinfo; reserved : 0),
-       (unicode : 142; flag : umf_noinfo; reserved : 0),
-       (unicode : 143; flag : umf_noinfo; reserved : 0),
-       (unicode : 144; flag : umf_noinfo; reserved : 0),
-       (unicode : 145; flag : umf_noinfo; reserved : 0),
-       (unicode : 146; flag : umf_noinfo; reserved : 0),
-       (unicode : 147; flag : umf_noinfo; reserved : 0),
-       (unicode : 148; flag : umf_noinfo; reserved : 0),
-       (unicode : 149; flag : umf_noinfo; reserved : 0),
-       (unicode : 150; flag : umf_noinfo; reserved : 0),
-       (unicode : 151; flag : umf_noinfo; reserved : 0),
-       (unicode : 152; flag : umf_noinfo; reserved : 0),
-       (unicode : 153; flag : umf_noinfo; reserved : 0),
-       (unicode : 154; flag : umf_noinfo; reserved : 0),
-       (unicode : 155; flag : umf_noinfo; reserved : 0),
-       (unicode : 156; flag : umf_noinfo; reserved : 0),
-       (unicode : 157; flag : umf_noinfo; reserved : 0),
-       (unicode : 158; flag : umf_noinfo; reserved : 0),
-       (unicode : 159; flag : umf_noinfo; reserved : 0),
-       (unicode : 160; flag : umf_noinfo; reserved : 0),
-       (unicode : 161; flag : umf_noinfo; reserved : 0),
-       (unicode : 162; flag : umf_noinfo; reserved : 0),
-       (unicode : 163; flag : umf_noinfo; reserved : 0),
-       (unicode : 164; flag : umf_noinfo; reserved : 0),
-       (unicode : 165; flag : umf_noinfo; reserved : 0),
-       (unicode : 166; flag : umf_noinfo; reserved : 0),
-       (unicode : 167; flag : umf_noinfo; reserved : 0),
-       (unicode : 168; flag : umf_noinfo; reserved : 0),
-       (unicode : 169; flag : umf_noinfo; reserved : 0),
-       (unicode : 170; flag : umf_noinfo; reserved : 0),
-       (unicode : 171; flag : umf_noinfo; reserved : 0),
-       (unicode : 172; flag : umf_noinfo; reserved : 0),
-       (unicode : 173; flag : umf_noinfo; reserved : 0),
-       (unicode : 174; flag : umf_noinfo; reserved : 0),
-       (unicode : 175; flag : umf_noinfo; reserved : 0),
-       (unicode : 176; flag : umf_noinfo; reserved : 0),
-       (unicode : 177; flag : umf_noinfo; reserved : 0),
-       (unicode : 178; flag : umf_noinfo; reserved : 0),
-       (unicode : 179; flag : umf_noinfo; reserved : 0),
-       (unicode : 180; flag : umf_noinfo; reserved : 0),
-       (unicode : 181; flag : umf_noinfo; reserved : 0),
-       (unicode : 182; flag : umf_noinfo; reserved : 0),
-       (unicode : 183; flag : umf_noinfo; reserved : 0),
-       (unicode : 184; flag : umf_noinfo; reserved : 0),
-       (unicode : 185; flag : umf_noinfo; reserved : 0),
-       (unicode : 186; flag : umf_noinfo; reserved : 0),
-       (unicode : 187; flag : umf_noinfo; reserved : 0),
-       (unicode : 188; flag : umf_noinfo; reserved : 0),
-       (unicode : 189; flag : umf_noinfo; reserved : 0),
-       (unicode : 190; flag : umf_noinfo; reserved : 0),
-       (unicode : 191; flag : umf_noinfo; reserved : 0),
-       (unicode : 192; flag : umf_noinfo; reserved : 0),
-       (unicode : 193; flag : umf_noinfo; reserved : 0),
-       (unicode : 194; flag : umf_noinfo; reserved : 0),
-       (unicode : 195; flag : umf_noinfo; reserved : 0),
-       (unicode : 196; flag : umf_noinfo; reserved : 0),
-       (unicode : 197; flag : umf_noinfo; reserved : 0),
-       (unicode : 198; flag : umf_noinfo; reserved : 0),
-       (unicode : 199; flag : umf_noinfo; reserved : 0),
-       (unicode : 200; flag : umf_noinfo; reserved : 0),
-       (unicode : 201; flag : umf_noinfo; reserved : 0),
-       (unicode : 202; flag : umf_noinfo; reserved : 0),
-       (unicode : 203; flag : umf_noinfo; reserved : 0),
-       (unicode : 204; flag : umf_noinfo; reserved : 0),
-       (unicode : 205; flag : umf_noinfo; reserved : 0),
-       (unicode : 206; flag : umf_noinfo; reserved : 0),
-       (unicode : 207; flag : umf_noinfo; reserved : 0),
-       (unicode : 208; flag : umf_noinfo; reserved : 0),
-       (unicode : 209; flag : umf_noinfo; reserved : 0),
-       (unicode : 210; flag : umf_noinfo; reserved : 0),
-       (unicode : 211; flag : umf_noinfo; reserved : 0),
-       (unicode : 212; flag : umf_noinfo; reserved : 0),
-       (unicode : 213; flag : umf_noinfo; reserved : 0),
-       (unicode : 214; flag : umf_noinfo; reserved : 0),
-       (unicode : 215; flag : umf_noinfo; reserved : 0),
-       (unicode : 216; flag : umf_noinfo; reserved : 0),
-       (unicode : 217; flag : umf_noinfo; reserved : 0),
-       (unicode : 218; flag : umf_noinfo; reserved : 0),
-       (unicode : 219; flag : umf_noinfo; reserved : 0),
-       (unicode : 220; flag : umf_noinfo; reserved : 0),
-       (unicode : 221; flag : umf_noinfo; reserved : 0),
-       (unicode : 222; flag : umf_noinfo; reserved : 0),
-       (unicode : 223; flag : umf_noinfo; reserved : 0),
-       (unicode : 224; flag : umf_noinfo; reserved : 0),
-       (unicode : 225; flag : umf_noinfo; reserved : 0),
-       (unicode : 226; flag : umf_noinfo; reserved : 0),
-       (unicode : 227; flag : umf_noinfo; reserved : 0),
-       (unicode : 228; flag : umf_noinfo; reserved : 0),
-       (unicode : 229; flag : umf_noinfo; reserved : 0),
-       (unicode : 230; flag : umf_noinfo; reserved : 0),
-       (unicode : 231; flag : umf_noinfo; reserved : 0),
-       (unicode : 232; flag : umf_noinfo; reserved : 0),
-       (unicode : 233; flag : umf_noinfo; reserved : 0),
-       (unicode : 234; flag : umf_noinfo; reserved : 0),
-       (unicode : 235; flag : umf_noinfo; reserved : 0),
-       (unicode : 236; flag : umf_noinfo; reserved : 0),
-       (unicode : 237; flag : umf_noinfo; reserved : 0),
-       (unicode : 238; flag : umf_noinfo; reserved : 0),
-       (unicode : 239; flag : umf_noinfo; reserved : 0),
-       (unicode : 240; flag : umf_noinfo; reserved : 0),
-       (unicode : 241; flag : umf_noinfo; reserved : 0),
-       (unicode : 242; flag : umf_noinfo; reserved : 0),
-       (unicode : 243; flag : umf_noinfo; reserved : 0),
-       (unicode : 244; flag : umf_noinfo; reserved : 0),
-       (unicode : 245; flag : umf_noinfo; reserved : 0),
-       (unicode : 246; flag : umf_noinfo; reserved : 0),
-       (unicode : 247; flag : umf_noinfo; reserved : 0),
-       (unicode : 248; flag : umf_noinfo; reserved : 0),
-       (unicode : 249; flag : umf_noinfo; reserved : 0),
-       (unicode : 250; flag : umf_noinfo; reserved : 0),
-       (unicode : 251; flag : umf_noinfo; reserved : 0),
-       (unicode : 252; flag : umf_noinfo; reserved : 0),
-       (unicode : 253; flag : umf_noinfo; reserved : 0),
-       (unicode : 254; flag : umf_noinfo; reserved : 0),
-       (unicode : 255; flag : umf_noinfo; reserved : 0)
-     );
-
-     unicodemap : tunicodemap = (
-       cpname : '8859-1';
-       map : @map;
-       lastchar : 255;
-       next : nil;
-       internalmap : true
-     );
-
-  begin
-     registermapping(@unicodemap)
-  end.

compiler/compiler/crc.pas

@@ -1,100 +0,0 @@
-{
-    Copyright (c) 2000-2002 by Free Pascal Development Team
-
-    Routines to compute CRC values
-
-    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 crc;
-
-{$i fpcdefs.inc}
-
-Interface
-
-Function Crc32(Const HStr:String):cardinal;
-Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:integer):cardinal;
-Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
-
-
-Implementation
-
-{*****************************************************************************
-                                   Crc 32
-*****************************************************************************}
-
-var
-  Crc32Tbl : array[0..255] of cardinal;
-
-procedure MakeCRC32Tbl;
-var
-  crc : cardinal;
-  i,n : integer;
-begin
-  for i:=0 to 255 do
-   begin
-     crc:=i;
-     for n:=1 to 8 do
-      if (crc and 1)<>0 then
-       crc:=(crc shr 1) xor cardinal($edb88320)
-      else
-       crc:=crc shr 1;
-     Crc32Tbl[i]:=crc;
-   end;
-end;
-
-
-Function Crc32(Const HStr:String):cardinal;
-var
-  i : integer;
-  InitCrc : cardinal;
-begin
-  if Crc32Tbl[1]=0 then
-   MakeCrc32Tbl;
-  InitCrc:=cardinal($ffffffff);
-  for i:=1 to Length(Hstr) do
-   InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(Hstr[i])] xor (InitCrc shr 8);
-  Crc32:=InitCrc;
-end;
-
-
-
-Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:Integer):cardinal;
-var
-  i : integer;
-  p : pchar;
-begin
-  if Crc32Tbl[1]=0 then
-   MakeCrc32Tbl;
-  p:=@InBuf;
-  for i:=1 to InLen do
-   begin
-     InitCrc:=Crc32Tbl[byte(InitCrc) xor byte(p^)] xor (InitCrc shr 8);
-     inc(p);
-   end;
-  UpdateCrc32:=InitCrc;
-end;
-
-
-
-Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
-begin
-  if Crc32Tbl[1]=0 then
-   MakeCrc32Tbl;
-  UpdCrc32:=Crc32Tbl[byte(InitCrc) xor b] xor (InitCrc shr 8);
-end;
-
-end.

compiler/compiler/cresstr.pas

@@ -1,294 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Michael van Canneyt
-
-    Handles resourcestrings
-
-    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 cresstr;
-
-{$i fpcdefs.inc}
-
-interface
-
-uses
-  cclasses;
-
-Type
-  { These are used to form a singly-linked list, ordered by hash value }
-  TResourceStringItem = class(TLinkedListItem)
-    Name  : String;
-    Value : Pchar;
-    Len   : Longint;
-    hash  : Cardinal;
-    constructor Create(const AName:string;AValue:pchar;ALen:longint);
-    destructor  Destroy;override;
-    procedure CalcHash;
-  end;
-
-  Tresourcestrings=class
-  private
-    List : TLinkedList;
-  public
-    ResStrCount : longint;
-    constructor Create;
-    destructor  Destroy;override;
-    function  Register(Const name : string;p : pchar;len : longint) : longint;
-    procedure CreateResourceStringList;
-    Procedure WriteResourceFile(const FileName : String);
-  end;
-
-var
-  resourcestrings : Tresourcestrings;
-
-
-implementation
-
-uses
-   cutils,globtype,globals,
-   symdef,
-   verbose,fmodule,
-   aasmbase,aasmtai,
-   aasmcpu;
-
-
-{ ---------------------------------------------------------------------
-   Calculate hash value, based on the string
-  ---------------------------------------------------------------------}
-
-{ ---------------------------------------------------------------------
-                          TRESOURCESTRING_ITEM
-  ---------------------------------------------------------------------}
-
-constructor TResourceStringItem.Create(const AName:string;AValue:pchar;ALen:longint);
-begin
-  inherited Create;
-  Name:=AName;
-  Len:=ALen;
-  GetMem(Value,Len);
-  Move(AValue^,Value^,Len);
-  CalcHash;
-end;
-
-
-destructor TResourceStringItem.Destroy;
-begin
-  FreeMem(Value,Len);
-end;
-
-procedure TResourceStringItem.CalcHash;
-Var
-  g : Cardinal;
-  I : longint;
-begin
-  hash:=0;
-  For I:=0 to Len-1 do { 0 terminated }
-   begin
-     hash:=hash shl 4;
-     inc(Hash,Ord(Value[i]));
-     g:=hash and ($f shl 28);
-     if g<>0 then
-      begin
-        hash:=hash xor (g shr 24);
-        hash:=hash xor g;
-      end;
-   end;
-  If Hash=0 then
-    Hash:=$ffffffff;
-end;
-
-
-{ ---------------------------------------------------------------------
-                          Tresourcestrings
-  ---------------------------------------------------------------------}
-
-Constructor Tresourcestrings.Create;
-begin
-  List:=TStringList.Create;
-  ResStrCount:=0;
-end;
-
-
-Destructor Tresourcestrings.Destroy;
-begin
-  List.Free;
-end;
-
-
-{ ---------------------------------------------------------------------
-    Create the full asmlist for resourcestrings.
-  ---------------------------------------------------------------------}
-
-procedure Tresourcestrings.CreateResourceStringList;
-
-  Procedure AppendToAsmResList (P : TResourceStringItem);
-  Var
-    l1 : tasmlabel;
-    s : pchar;
-    l : longint;
-  begin
-    with p Do
-     begin
-       if (Value=nil) or (len=0) then
-         asmlist[al_resourcestrings].concat(tai_const.create_sym(nil))
-       else
-         begin
-            objectlibrary.getdatalabel(l1);
-            asmlist[al_resourcestrings].concat(tai_const.create_sym(l1));
-            maybe_new_object_file(asmlist[al_const]);
-            asmlist[al_const].concat(tai_align.Create(const_align(sizeof(aint))));
-            asmlist[al_const].concat(tai_const.create_aint(-1));
-            asmlist[al_const].concat(tai_const.create_aint(len));
-            asmlist[al_const].concat(tai_label.create(l1));
-            getmem(s,len+1);
-            move(value^,s^,len);
-            s[len]:=#0;
-            asmlist[al_const].concat(tai_string.create_pchar(s,len));
-            asmlist[al_const].concat(tai_const.create_8bit(0));
-         end;
-       { append Current value (nil) and hash...}
-       asmlist[al_resourcestrings].concat(tai_const.create_sym(nil));
-       asmlist[al_resourcestrings].concat(tai_const.create_32bit(longint(hash)));
-       { Append the name as a ansistring. }
-       objectlibrary.getdatalabel(l1);
-       l:=length(name);
-       asmlist[al_resourcestrings].concat(tai_const.create_sym(l1));
-       maybe_new_object_file(asmlist[al_const]);
-       asmlist[al_const].concat(tai_align.create(const_align(sizeof(aint))));
-       asmlist[al_const].concat(tai_const.create_aint(-1));
-       asmlist[al_const].concat(tai_const.create_aint(l));
-       asmlist[al_const].concat(tai_label.create(l1));
-       getmem(s,l+1);
-       move(Name[1],s^,l);
-       s[l]:=#0;
-       asmlist[al_const].concat(tai_string.create_pchar(s,l));
-       asmlist[al_const].concat(tai_const.create_8bit(0));
-     end;
-  end;
-
-Var
-  R : tresourceStringItem;
-begin
-  if asmlist[al_resourcestrings]=nil then
-    asmlist[al_resourcestrings]:=taasmoutput.create;
-  maybe_new_object_file(asmlist[al_resourcestrings]);
-  new_section(asmlist[al_resourcestrings],sec_data,'',4);
-  asmlist[al_resourcestrings].concat(tai_align.create(const_align(sizeof(aint))));
-  asmlist[al_resourcestrings].concat(tai_symbol.createname_global(
-    make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),AT_DATA,0));
-  asmlist[al_resourcestrings].concat(tai_const.create_32bit(resstrcount));
-  R:=TResourceStringItem(List.First);
-  while assigned(R) do
-   begin
-     AppendToAsmResList(R);
-     R:=TResourceStringItem(R.Next);
-   end;
-  asmlist[al_resourcestrings].concat(tai_symbol_end.createname(
-    current_module.modulename^+'_'+'RESOURCESTRINGLIST'));
-end;
-
-
-{ ---------------------------------------------------------------------
-    Insert 1 resource string in all tables.
-  ---------------------------------------------------------------------}
-
-function  Tresourcestrings.Register(const name : string;p : pchar;len : longint) : longint;
-begin
-  List.Concat(tResourceStringItem.Create(lower(current_module.modulename^+'.'+Name),p,len));
-  Register:=ResStrCount;
-  inc(ResStrCount);
-end;
-
-
-Procedure Tresourcestrings.WriteResourceFile(const FileName : String);
-Type
-  TMode = (quoted,unquoted);
-Var
-  F : Text;
-  Mode : TMode;
-  R : TResourceStringItem;
-  C : char;
-  Col,i : longint;
-
-  Procedure Add(Const S : String);
-  begin
-    Write(F,S);
-    Col:=Col+length(s);
-  end;
-
-begin
-  If List.Empty then
-    exit;
-  message1 (general_i_writingresourcefile,SplitFileName(filename));
-  Assign(F,Filename);
-  {$i-}
-  Rewrite(f);
-  {$i+}
-  If IOresult<>0 then
-    begin
-      message1(general_e_errorwritingresourcefile,filename);
-      exit;
-    end;
-  R:=TResourceStringItem(List.First);
-  While assigned(R) do
-   begin
-     writeln(f);
-     Writeln(f,'# hash value = ',R.hash);
-     col:=0;
-     Add(R.Name+'=');
-     Mode:=unquoted;
-     For I:=0 to R.Len-1 do
-      begin
-        C:=R.Value[i];
-        If (ord(C)>31) and (Ord(c)<=128) and (c<>'''') then
-         begin
-           If mode=Quoted then
-            Add(c)
-           else
-            begin
-              Add(''''+c);
-              mode:=quoted
-            end;
-         end
-        else
-         begin
-           If Mode=quoted then
-            begin
-              Add('''');
-              mode:=unquoted;
-            end;
-           Add('#'+tostr(ord(c)));
-         end;
-        If Col>72 then
-         begin
-           if mode=quoted then
-            Write (F,'''');
-           Writeln(F,'+');
-           Col:=0;
-           Mode:=unQuoted;
-         end;
-      end;
-     if mode=quoted then
-      writeln (f,'''');
-     Writeln(f);
-     R:=TResourceStringItem(R.Next);
-   end;
-  close(f);
-end;
-
-
-end.

compiler/compiler/cstreams.pas

@@ -1,613 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
-
-    This module provides stream classes
-
-    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 cstreams;
-
-{$i fpcdefs.inc}
-
-interface
-
-   uses
-     cutils;
-
-
-{****************************************************************************
-                                  TCStream
-****************************************************************************}
-
-    {
-      TCStream is copied directly from classesh.inc from the FCL so
-      it's compatible with the normal Classes.TStream.
-
-      TCFileStream is a merge of THandleStream and TFileStream and updated
-      to have a 'file' type instead of Handle.
-
-      TCCustomMemoryStream and TCMemoryStream are direct copies.
-    }
-    const
-       { TCStream seek origins }
-       soFromBeginning = 0;
-       soFromCurrent = 1;
-       soFromEnd = 2;
-
-       { TCFileStream create mode }
-       fmCreate        = $FFFF;
-       fmOpenRead      = 0;
-       fmOpenWrite     = 1;
-       fmOpenReadWrite = 2;
-
-var
-{ Used for Error reporting instead of exceptions }
-  CStreamError : longint;
-
-type
-{ Fake TComponent class, it isn't used any futher }
-  TCComponent = class(TObject)
-  end;
-
-{ TCStream abstract class }
-
-  TCStream = class(TObject)
-  private
-    function GetPosition: Longint;
-    procedure SetPosition(Pos: Longint);
-    function GetSize: Longint;
-  protected
-    procedure SetSize(NewSize: Longint); virtual;
-  public
-    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
-    function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
-    function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
-    procedure ReadBuffer(var Buffer; Count: Longint);
-    procedure WriteBuffer(const Buffer; Count: Longint);
-    function CopyFrom(Source: TCStream; Count: Longint): Longint;
-    function ReadComponent(Instance: TCComponent): TCComponent;
-    function ReadComponentRes(Instance: TCComponent): TCComponent;
-    procedure WriteComponent(Instance: TCComponent);
-    procedure WriteComponentRes(const ResName: string; Instance: TCComponent);
-    procedure WriteDescendent(Instance, Ancestor: TCComponent);
-    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TCComponent);
-    procedure WriteResourceHeader(const ResName: string; {!!!:out} var FixupInfo: Integer);
-    procedure FixupResourceHeader(FixupInfo: Integer);
-    procedure ReadResHeader;
-    function ReadByte : Byte;
-    function ReadWord : Word;
-    function ReadDWord : Cardinal;
-    function ReadAnsiString : AnsiString;
-    procedure WriteByte(b : Byte);
-    procedure WriteWord(w : Word);
-    procedure WriteDWord(d : Cardinal);
-    Procedure WriteAnsiString (S : AnsiString);
-    property Position: Longint read GetPosition write SetPosition;
-    property Size: Longint read GetSize write SetSize;
-  end;
-
-{ TFileStream class }
-
-  TCFileStream = class(TCStream)
-  Private
-    FFileName : String;
-    FHandle: File;
-  protected
-    procedure SetSize(NewSize: Longint); override;
-  public
-    constructor Create(const AFileName: string; Mode: Word);
-    destructor Destroy; override;
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    property FileName : String Read FFilename;
-  end;
-
-{ TCustomMemoryStream abstract class }
-
-  TCCustomMemoryStream = class(TCStream)
-  private
-    FMemory: Pointer;
-    FSize, FPosition: Longint;
-  protected
-    procedure SetPointer(Ptr: Pointer; ASize: Longint);
-  public
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    procedure SaveToStream(Stream: TCStream);
-    procedure SaveToFile(const FileName: string);
-    property Memory: Pointer read FMemory;
-  end;
-
-{ TCMemoryStream }
-
-  TCMemoryStream = class(TCCustomMemoryStream)
-  private
-    FCapacity: Longint;
-    procedure SetCapacity(NewCapacity: Longint);
-  protected
-    function Realloc(var NewCapacity: Longint): Pointer; virtual;
-    property Capacity: Longint read FCapacity write SetCapacity;
-  public
-    destructor Destroy; override;
-    procedure Clear;
-    procedure LoadFromStream(Stream: TCStream);
-    procedure LoadFromFile(const FileName: string);
-    procedure SetSize(NewSize: Longint); override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-  end;
-
-
-implementation
-
-  Type
-    PByte = ^Byte;
-
-{*****************************************************************************
-                                   TCStream
-*****************************************************************************}
-
-  function TCStream.GetPosition: Longint;
-
-    begin
-       Result:=Seek(0,soFromCurrent);
-    end;
-
-  procedure TCStream.SetPosition(Pos: Longint);
-
-    begin
-       Seek(pos,soFromBeginning);
-    end;
-
-  function TCStream.GetSize: Longint;
-
-    var
-       p : longint;
-
-    begin
-       p:=GetPosition;
-       GetSize:=Seek(0,soFromEnd);
-       Seek(p,soFromBeginning);
-    end;
-
-  procedure TCStream.SetSize(NewSize: Longint);
-
-    begin
-    // We do nothing. Pipe streams don't support this
-    // As wel as possible read-ony streams !!
-    end;
-
-  procedure TCStream.ReadBuffer(var Buffer; Count: Longint);
-
-    begin
-       CStreamError:=0;
-       if Read(Buffer,Count)<Count then
-         CStreamError:=102;
-    end;
-
-  procedure TCStream.WriteBuffer(const Buffer; Count: Longint);
-
-    begin
-       CStreamError:=0;
-       if Write(Buffer,Count)<Count then
-         CStreamError:=103;
-    end;
-
-  function TCStream.CopyFrom(Source: TCStream; Count: Longint): Longint;
-
-    var
-       i : longint;
-       buffer : array[0..1023] of byte;
-
-    begin
-       CStreamError:=0;
-       Result:=0;
-       while Count>0 do
-         begin
-            if (Count>sizeof(buffer)) then
-              i:=sizeof(Buffer)
-            else
-              i:=Count;
-            i:=Source.Read(buffer,i);
-            i:=Write(buffer,i);
-            dec(count,i);
-            inc(Result,i);
-            if i=0 then
-              exit;
-         end;
-    end;
-
-  function TCStream.ReadComponent(Instance: TCComponent): TCComponent;
-    begin
-      Result:=nil;
-    end;
-
-  function TCStream.ReadComponentRes(Instance: TCComponent): TCComponent;
-    begin
-      Result:=nil;
-    end;
-
-  procedure TCStream.WriteComponent(Instance: TCComponent);
-    begin
-    end;
-
-  procedure TCStream.WriteComponentRes(const ResName: string; Instance: TCComponent);
-    begin
-    end;
-
-  procedure TCStream.WriteDescendent(Instance, Ancestor: TCComponent);
-    begin
-    end;
-
-  procedure TCStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TCComponent);
-    begin
-    end;
-
-  procedure TCStream.WriteResourceHeader(const ResName: string; {!!!: out} var FixupInfo: Integer);
-    begin
-    end;
-
-  procedure TCStream.FixupResourceHeader(FixupInfo: Integer);
-    begin
-    end;
-
-  procedure TCStream.ReadResHeader;
-    begin
-    end;
-
-  function TCStream.ReadByte : Byte;
-
-    var
-       b : Byte;
-
-    begin
-       ReadBuffer(b,1);
-       ReadByte:=b;
-    end;
-
-  function TCStream.ReadWord : Word;
-
-    var
-       w : Word;
-
-    begin
-       ReadBuffer(w,2);
-       ReadWord:=w;
-    end;
-
-  function TCStream.ReadDWord : Cardinal;
-
-    var
-       d : Cardinal;
-
-    begin
-       ReadBuffer(d,4);
-       ReadDWord:=d;
-    end;
-
-  Function TCStream.ReadAnsiString : AnsiString;
-  Var
-    TheSize : Longint;
-    P : PByte ;
-  begin
-    ReadBuffer (TheSize,SizeOf(TheSize));
-    SetLength(Result,TheSize);
-    // Illegal typecast if no AnsiStrings defined.
-    if TheSize>0 then
-     begin
-       ReadBuffer (Pointer(Result)^,TheSize);
-       P:=PByte(PtrInt(Result)+TheSize);
-       p^:=0;
-     end;
-   end;
-
-  Procedure TCStream.WriteAnsiString (S : AnsiString);
-
-  Var L : Longint;
-
-  begin
-    L:=Length(S);
-    WriteBuffer (L,SizeOf(L));
-    WriteBuffer (Pointer(S)^,L);
-  end;
-
-  procedure TCStream.WriteByte(b : Byte);
-
-    begin
-       WriteBuffer(b,1);
-    end;
-
-  procedure TCStream.WriteWord(w : Word);
-
-    begin
-       WriteBuffer(w,2);
-    end;
-
-  procedure TCStream.WriteDWord(d : Cardinal);
-
-    begin
-       WriteBuffer(d,4);
-    end;
-
-
-{****************************************************************************}
-{*                             TCFileStream                                  *}
-{****************************************************************************}
-
-constructor TCFileStream.Create(const AFileName: string; Mode: Word);
-begin
-  FFileName:=AFileName;
-  If Mode=fmcreate then
-    begin
-      system.assign(FHandle,AFileName);
-      {$I-}
-       system.rewrite(FHandle,1);
-      {$I+}
-      CStreamError:=IOResult;
-    end
-  else
-    begin
-      system.assign(FHandle,AFileName);
-      {$I-}
-       system.reset(FHandle,1);
-      {$I+}
-      CStreamError:=IOResult;
-    end;
-end;
-
-
-destructor TCFileStream.Destroy;
-begin
-  {$I-}
-   System.Close(FHandle);
-  {$I+}
-  CStreamError:=IOResult;
-end;
-
-
-function TCFileStream.Read(var Buffer; Count: Longint): Longint;
-begin
-  CStreamError:=0;
-  BlockRead(FHandle,Buffer,Count,Result);
-  If Result=-1 then Result:=0;
-end;
-
-
-function TCFileStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  CStreamError:=0;
-  BlockWrite (FHandle,(@Buffer)^,Count,Result);
-  If Result=-1 then Result:=0;
-end;
-
-
-Procedure TCFileStream.SetSize(NewSize: Longint);
-begin
-  {$I-}
-   System.Seek(FHandle,NewSize);
-   System.Truncate(FHandle);
-  {$I+}
-  CStreamError:=IOResult;
-end;
-
-
-function TCFileStream.Seek(Offset: Longint; Origin: Word): Longint;
-var
-  l : longint;
-begin
-  {$I-}
-   case Origin of
-     soFromBeginning :
-       System.Seek(FHandle,Offset);
-     soFromCurrent :
-       begin
-         l:=System.FilePos(FHandle);
-         inc(l,Offset);
-         System.Seek(FHandle,l);
-       end;
-     soFromEnd :
-       begin
-         l:=System.FileSize(FHandle);
-         dec(l,Offset);
-         if l<0 then
-          l:=0;
-         System.Seek(FHandle,l);
-       end;
-   end;
-  {$I+}
-  CStreamError:=IOResult;
-  Result:=CStreamError;
-end;
-
-
-{****************************************************************************}
-{*                             TCustomMemoryStream                          *}
-{****************************************************************************}
-
-procedure TCCustomMemoryStream.SetPointer(Ptr: Pointer; ASize: Longint);
-
-begin
-  FMemory:=Ptr;
-  FSize:=ASize;
-end;
-
-
-function TCCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Result:=0;
-  If (FSize>0) and (FPosition<Fsize) then
-    begin
-    Result:=FSize-FPosition;
-    If Result>Count then Result:=Count;
-    Move (Pointer(PtrInt(FMemory)+FPosition)^,Buffer,Result);
-    FPosition:=Fposition+Result;
-    end;
-end;
-
-
-function TCCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-begin
-  Case Origin of
-    soFromBeginning : FPosition:=Offset;
-    soFromEnd       : FPosition:=FSize+Offset;
-    soFromCurrent   : FpoSition:=FPosition+Offset;
-  end;
-  Result:=FPosition;
-end;
-
-
-procedure TCCustomMemoryStream.SaveToStream(Stream: TCStream);
-
-begin
-  if FSize>0 then Stream.WriteBuffer (FMemory^,FSize);
-end;
-
-
-procedure TCCustomMemoryStream.SaveToFile(const FileName: string);
-
-Var S : TCFileStream;
-
-begin
-  Try
-    S:=TCFileStream.Create (FileName,fmCreate);
-    SaveToStream(S);
-  finally
-    S.free;
-  end;
-end;
-
-
-{****************************************************************************}
-{*                             TCMemoryStream                                *}
-{****************************************************************************}
-
-
-Const TMSGrow = 4096; { Use 4k blocks. }
-
-procedure TCMemoryStream.SetCapacity(NewCapacity: Longint);
-
-begin
-  SetPointer (Realloc(NewCapacity),Fsize);
-  FCapacity:=NewCapacity;
-end;
-
-
-function TCMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
-
-Var MoveSize : Longint;
-
-begin
-  CStreamError:=0;
-  If NewCapacity>0 Then // round off to block size.
-    NewCapacity := (NewCapacity + (TMSGrow-1)) and not (TMSGROW-1);
-  // Only now check !
-  If NewCapacity=FCapacity then
-    Result:=FMemory
-  else
-    If NewCapacity=0 then
-      FreeMem (FMemory,Fcapacity)
-    else
-      begin
-      GetMem (Result,NewCapacity);
-      If Result=Nil then
-        CStreamError:=204;
-      If FCapacity>0 then
-        begin
-        MoveSize:=FSize;
-        If MoveSize>NewCapacity then MoveSize:=NewCapacity;
-        Move (Fmemory^,Result^,MoveSize);
-        FreeMem (FMemory,FCapacity);
-        end;
-      end;
-end;
-
-
-destructor TCMemoryStream.Destroy;
-
-begin
-  Clear;
-  Inherited Destroy;
-end;
-
-
-procedure TCMemoryStream.Clear;
-
-begin
-  FSize:=0;
-  FPosition:=0;
-  SetCapacity (0);
-end;
-
-
-procedure TCMemoryStream.LoadFromStream(Stream: TCStream);
-
-begin
-  Stream.Position:=0;
-  SetSize(Stream.Size);
-  If FSize>0 then Stream.ReadBuffer(FMemory^,FSize);
-end;
-
-
-procedure TCMemoryStream.LoadFromFile(const FileName: string);
-
-Var S : TCFileStream;
-
-begin
-  Try
-    S:=TCFileStream.Create (FileName,fmOpenRead);
-    LoadFromStream(S);
-  finally
-    S.free;
-  end;
-end;
-
-
-procedure TCMemoryStream.SetSize(NewSize: Longint);
-
-begin
-  SetCapacity (NewSize);
-  FSize:=NewSize;
-  IF FPosition>FSize then
-    FPosition:=FSize;
-end;
-
-
-function TCMemoryStream.Write(const Buffer; Count: Longint): Longint;
-
-Var NewPos : Longint;
-
-begin
-  If Count=0 then
-   begin
-     Result:=0;
-     exit;
-   end;
-  NewPos:=FPosition+Count;
-  If NewPos>Fsize then
-    begin
-    IF NewPos>FCapacity then
-      SetCapacity (NewPos);
-    FSize:=Newpos;
-    end;
-  System.Move (Buffer,Pointer(Ptrint(FMemory)+FPosition)^,Count);
-  FPosition:=NewPos;
-  Result:=Count;
-end;
-
-end.

compiler/compiler/cutils.pas

@@ -1,1081 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    This unit implements some support functions
-
-    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 some generic support functions which are used
-   in the different parts of the compiler.
-}
-unit cutils;
-
-{$i fpcdefs.inc}
-
-interface
-
-
-    type
-       pstring = ^string;
-       Tcharset=set of char;
-
-    var
-      internalerrorproc : procedure(i:longint);
-
-
-    {# Returns the minimal value between @var(a) and @var(b) }
-    function min(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
-    function min(a,b : int64) : int64;{$ifdef USEINLINE}inline;{$endif}
-    {# Returns the maximum value between @var(a) and @var(b) }
-    function max(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
-    function max(a,b : int64) : int64;{$ifdef USEINLINE}inline;{$endif}
-    {# Returns the value in @var(x) swapped to different endian }
-    Function SwapInt64(x : int64): int64;{$ifdef USEINLINE}inline;{$endif}
-    {# Returns the value in @var(x) swapped to different endian }
-    function SwapLong(x : longint): longint;{$ifdef USEINLINE}inline;{$endif}
-    {# Returns the value in @va(x) swapped to different endian }
-    function SwapWord(x : word): word;{$ifdef USEINLINE}inline;{$endif}
-    {# Return value @var(i) aligned on @var(a) boundary }
-    function align(i,a:longint):longint;{$ifdef USEINLINE}inline;{$endif}
-
-    function used_align(varalign,minalign,maxalign:longint):longint;
-    function size_2_align(len : longint) : longint;
-    procedure Replace(var s:string;s1:string;const s2:string);
-    procedure Replace(var s:AnsiString;s1:string;const s2:string);
-    procedure ReplaceCase(var s:string;const s1,s2:string);
-    function upper(const s : string) : string;
-    function lower(const s : string) : string;
-    function trimbspace(const s:string):string;
-    function trimspace(const s:string):string;
-    function space (b : longint): string;
-    function PadSpace(const s:string;len:longint):string;
-    function GetToken(var s:string;endchar:char):string;
-    procedure uppervar(var s : string);
-    function hexstr(val : cardinal;cnt : cardinal) : string;
-    function realtostr(e:extended):string;{$ifdef USEINLINE}inline;{$endif}
-    function tostr(i : qword) : string;{$ifdef USEINLINE}inline;{$endif}overload;
-    function tostr(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}overload;
-    function tostr(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}overload;
-    function tostr_with_plus(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}
-    function DStr(l:longint):string;
-    {# Returns true if the string s is a number }
-    function is_number(const s : string) : boolean;{$ifdef USEINLINE}inline;{$endif}
-    {# Returns true if value is a power of 2, the actual
-       exponent value is returned in power.
-    }
-    function ispowerof2(value : int64;out power : longint) : boolean;
-    function backspace_quote(const s:string;const qchars:Tcharset):string;
-    function octal_quote(const s:string;const qchars:Tcharset):string;
-    function maybequoted(const s:string):string;
-
-    {# If the string is quoted, in accordance with pascal, it is
-       dequoted and returned in s, and the function returns true.
-       If it is not quoted, or if the quoting is bad, s is not touched,
-       and false is returned.
-    }
-    function DePascalQuote(var s: string): Boolean;
-    function CompareText(S1, S2: string): longint;
-
-    { releases the string p and assignes nil to p }
-    { if p=nil then freemem isn't called          }
-    procedure stringdispose(var p : pstring);{$ifdef USEINLINE}inline;{$endif}
-
-
-    { allocates mem for a copy of s, copies s to this mem and returns }
-    { a pointer to this mem                                           }
-    function stringdup(const s : string) : pstring;{$ifdef USEINLINE}inline;{$endif}
-
-    {# Allocates memory for the string @var(s) and copies s as zero
-       terminated string to that allocated memory and returns a pointer
-       to that mem
-    }
-    function  strpnew(const s : string) : pchar;
-    procedure strdispose(var p : pchar);
-
-    {# makes the character @var(c) lowercase, with spanish, french and german
-       character set
-    }
-    function lowercase(c : char) : char;
-
-    { makes zero terminated string to a pascal string }
-    { the data in p is modified and p is returned     }
-    function pchar2pstring(p : pchar) : pstring;
-
-    { ambivalent to pchar2pstring }
-    function pstring2pchar(p : pstring) : pchar;
-
-    { Speed/Hash value }
-    Function GetSpeedValue(Const s:String):cardinal;
-
-    { Ansistring (pchar+length) support }
-    procedure ansistringdispose(var p : pchar;length : longint);
-    function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
-    function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
-
-    {Lzw encode/decode to compress strings -> save memory.}
-    function minilzw_encode(const s:string):string;
-    function minilzw_decode(const s:string):string;
-
-
-implementation
-
-uses
-  strings
-  ;
-
-
-    var
-      uppertbl,
-      lowertbl  : array[char] of char;
-
-
-    function min(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
-    {
-      return the minimal of a and b
-    }
-      begin
-         if a>b then
-           min:=b
-         else
-           min:=a;
-      end;
-
-
-    function min(a,b : int64) : int64;{$ifdef USEINLINE}inline;{$endif}
-    {
-      return the minimal of a and b
-    }
-      begin
-         if a>b then
-           min:=b
-         else
-           min:=a;
-      end;
-
-
-    function max(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
-    {
-      return the maximum of a and b
-    }
-      begin
-         if a<b then
-           max:=b
-         else
-           max:=a;
-      end;
-
-
-    function max(a,b : int64) : int64;{$ifdef USEINLINE}inline;{$endif}
-    {
-      return the maximum of a and b
-    }
-      begin
-         if a<b then
-           max:=b
-         else
-           max:=a;
-      end;
-
-
-    Function SwapLong(x : longint): longint;{$ifdef USEINLINE}inline;{$endif}
-      var
-        y : word;
-        z : word;
-      Begin
-        y := x shr 16;
-        y := word(longint(y) shl 8) or (y shr 8);
-        z := x and $FFFF;
-        z := word(longint(z) shl 8) or (z shr 8);
-        SwapLong := (longint(z) shl 16) or longint(y);
-      End;
-
-
-    Function SwapInt64(x : int64): int64;{$ifdef USEINLINE}inline;{$endif}
-      Begin
-        result:=swaplong(longint(hi(x)));
-        result:=result or (swaplong(longint(lo(x))) shl 32);
-      End;
-
-
-    Function SwapWord(x : word): word;{$ifdef USEINLINE}inline;{$endif}
-      var
-        z : byte;
-      Begin
-        z := x shr 8;
-        x := x and $ff;
-        x := (x shl 8);
-        SwapWord := x or z;
-      End;
-
-
-    function align(i,a:longint):longint;{$ifdef USEINLINE}inline;{$endif}
-    {
-      return value <i> aligned <a> boundary
-    }
-      begin
-        { for 0 and 1 no aligning is needed }
-        if a<=1 then
-          result:=i
-        else
-          begin
-            if i<0 then
-              result:=((i-a+1) div a) * a
-            else
-              result:=((i+a-1) div a) * a;
-          end;
-      end;
-
-
-    function size_2_align(len : longint) : longint;
-      begin
-         if len>16 then
-           size_2_align:=32
-         else if len>8 then
-           size_2_align:=16
-         else if len>4 then
-           size_2_align:=8
-         else if len>2 then
-           size_2_align:=4
-         else if len>1 then
-           size_2_align:=2
-         else
-           size_2_align:=1;
-      end;
-
-
-    function used_align(varalign,minalign,maxalign:longint):longint;
-      begin
-        { varalign  : minimum alignment required for the variable
-          minalign  : Minimum alignment of this structure, 0 = undefined
-          maxalign  : Maximum alignment of this structure, 0 = undefined }
-        if (minalign>0) and
-           (varalign<minalign) then
-         used_align:=minalign
-        else
-         begin
-           if (maxalign>0) and
-              (varalign>maxalign) then
-            used_align:=maxalign
-           else
-            used_align:=varalign;
-         end;
-      end;
-
-
-    procedure Replace(var s:string;s1:string;const s2:string);
-      var
-         last,
-         i  : longint;
-      begin
-        s1:=upper(s1);
-        last:=0;
-        repeat
-          i:=pos(s1,upper(s));
-          if i=last then
-           i:=0;
-          if (i>0) then
-           begin
-             Delete(s,i,length(s1));
-             Insert(s2,s,i);
-             last:=i;
-           end;
-        until (i=0);
-      end;
-
-
-    procedure Replace(var s:AnsiString;s1:string;const s2:string);
-      var
-         last,
-         i  : longint;
-      begin
-        s1:=upper(s1);
-        last:=0;
-        repeat
-          i:=pos(s1,upper(s));
-          if i=last then
-           i:=0;
-          if (i>0) then
-           begin
-             Delete(s,i,length(s1));
-             Insert(s2,s,i);
-             last:=i;
-           end;
-        until (i=0);
-      end;
-
-
-    procedure ReplaceCase(var s:string;const s1,s2:string);
-      var
-         last,
-         i  : longint;
-      begin
-        last:=0;
-        repeat
-          i:=pos(s1,s);
-          if i=last then
-           i:=0;
-          if (i>0) then
-           begin
-             Delete(s,i,length(s1));
-             Insert(s2,s,i);
-             last:=i;
-           end;
-        until (i=0);
-      end;
-
-
-    function upper(const s : string) : string;
-    {
-      return uppercased string of s
-    }
-      var
-        i  : longint;
-      begin
-        for i:=1 to length(s) do
-          upper[i]:=uppertbl[s[i]];
-        upper[0]:=s[0];
-      end;
-
-
-    function lower(const s : string) : string;
-    {
-      return lowercased string of s
-    }
-      var
-        i : longint;
-      begin
-        for i:=1 to length(s) do
-          lower[i]:=lowertbl[s[i]];
-        lower[0]:=s[0];
-      end;
-
-
-    procedure uppervar(var s : string);
-    {
-      uppercase string s
-    }
-      var
-         i : longint;
-      begin
-         for i:=1 to length(s) do
-          s[i]:=uppertbl[s[i]];
-      end;
-
-
-    procedure initupperlower;
-      var
-        c : char;
-      begin
-        for c:=#0 to #255 do
-         begin
-           lowertbl[c]:=c;
-           uppertbl[c]:=c;
-           case c of
-             'A'..'Z' :
-               lowertbl[c]:=char(byte(c)+32);
-             'a'..'z' :
-               uppertbl[c]:=char(byte(c)-32);
-           end;
-         end;
-      end;
-
-
-    function hexstr(val : cardinal;cnt : cardinal) : string;
-      const
-        HexTbl : array[0..15] of char='0123456789ABCDEF';
-      var
-        i,j : cardinal;
-      begin
-        { calculate required length }
-        i:=0;
-        j:=val;
-        while (j>0) do
-         begin
-           inc(i);
-           j:=j shr 4;
-         end;
-        { generate fillers }
-        j:=0;
-        while (i+j<cnt) do
-         begin
-           inc(j);
-           hexstr[j]:='0';
-         end;
-        { generate hex }
-        inc(j,i);
-        hexstr[0]:=chr(j);
-        while (val>0) do
-         begin
-           hexstr[j]:=hextbl[val and $f];
-           dec(j);
-           val:=val shr 4;
-         end;
-      end;
-
-
-    function DStr(l:longint):string;
-      var
-        TmpStr : string[32];
-        i : longint;
-      begin
-        Str(l,TmpStr);
-        i:=Length(TmpStr);
-        while (i>3) do
-         begin
-           dec(i,3);
-           if TmpStr[i]<>'-' then
-            insert('.',TmpStr,i+1);
-         end;
-        DStr:=TmpStr;
-      end;
-
-
-    function trimbspace(const s:string):string;
-    {
-      return s with all leading spaces and tabs removed
-    }
-      var
-        i,j : longint;
-      begin
-        j:=1;
-        i:=length(s);
-        while (j<i) and (s[j] in [#9,' ']) do
-         inc(j);
-        trimbspace:=Copy(s,j,i-j+1);
-      end;
-
-
-
-    function trimspace(const s:string):string;
-    {
-      return s with all leading and ending spaces and tabs removed
-    }
-      var
-        i,j : longint;
-      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);
-        trimspace:=Copy(s,j,i-j+1);
-      end;
-
-
-    function space (b : longint): string;
-      var
-       s: string;
-      begin
-        space[0] := chr(b);
-        s[0] := chr(b);
-        FillChar (S[1],b,' ');
-        space:=s;
-      end;
-
-
-    function PadSpace(const s:string;len:longint):string;
-    {
-      return s with spaces add to the end
-    }
-      begin
-         if length(s)<len then
-          PadSpace:=s+Space(len-length(s))
-         else
-          PadSpace:=s;
-      end;
-
-
-    function GetToken(var s:string;endchar:char):string;
-      var
-        i : longint;
-      begin
-        GetToken:='';
-        s:=TrimSpace(s);
-        if (length(s)>0) and
-           (s[1]='''') then
-         begin
-           i:=1;
-           while (i<length(s)) do
-            begin
-              inc(i);
-              if s[i]='''' then
-               begin
-                 { Remove double quote }
-                 if (i<length(s)) and
-                    (s[i+1]='''') then
-                  begin
-                    Delete(s,i,1);
-                    inc(i);
-                  end
-                 else
-                  begin
-                    GetToken:=Copy(s,2,i-2);
-                    Delete(s,1,i);
-                    exit;
-                  end;
-               end;
-            end;
-           GetToken:=s;
-           s:='';
-         end
-        else
-         begin
-           i:=pos(EndChar,s);
-           if i=0 then
-            begin
-              GetToken:=s;
-              s:='';
-              exit;
-            end
-           else
-            begin
-              GetToken:=Copy(s,1,i-1);
-              Delete(s,1,i);
-              exit;
-            end;
-         end;
-      end;
-
-
-   function realtostr(e:extended):string;{$ifdef USEINLINE}inline;{$endif}
-     begin
-        str(e,result);
-     end;
-
-
-   function tostr(i : qword) : string;{$ifdef USEINLINE}inline;{$endif}overload;
-   {
-     return string of value i
-   }
-     begin
-        str(i,result);
-     end;
-
-
-   function tostr(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}overload;
-   {
-     return string of value i
-   }
-     begin
-        str(i,result);
-     end;
-
-
-   function tostr(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}overload;
-   {
-     return string of value i
-   }
-     begin
-        str(i,result);
-     end;
-
-
-   function tostr_with_plus(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}
-   {
-     return string of value i, but always include a + when i>=0
-   }
-     begin
-        str(i,result);
-        if i>=0 then
-          result:='+'+result;
-     end;
-
-
-    function is_number(const s : string) : boolean;{$ifdef USEINLINE}inline;{$endif}
-    {
-      is string a correct number ?
-    }
-      var
-         w : integer;
-         l : longint;
-      begin
-         val(s,l,w);
-         is_number:=(w=0);
-      end;
-
-
-    function ispowerof2(value : int64;out power : longint) : boolean;
-    {
-      return if value is a power of 2. And if correct return the power
-    }
-      var
-         hl : int64;
-         i : longint;
-      begin
-         if value and (value - 1) <> 0 then
-           begin
-             ispowerof2 := false;
-             exit
-           end;
-         hl:=1;
-         ispowerof2:=true;
-         for i:=0 to 63 do
-           begin
-              if hl=value then
-                begin
-                   power:=i;
-                   exit;
-                end;
-              hl:=hl shl 1;
-           end;
-         ispowerof2:=false;
-      end;
-
-
-    function backspace_quote(const s:string;const qchars:Tcharset):string;
-
-    var i:byte;
-
-    begin
-      backspace_quote:='';
-      for i:=1 to length(s) do
-        begin
-          if (s[i]=#10) and (#10 in qchars) then
-            backspace_quote:=backspace_quote+'\n'
-          else if (s[i]=#13) and (#13 in qchars) then
-            backspace_quote:=backspace_quote+'\r'
-          else
-            begin
-              if s[i] in qchars then
-                backspace_quote:=backspace_quote+'\';
-              backspace_quote:=backspace_quote+s[i];
-            end;
-        end;
-    end;
-
-    function octal_quote(const s:string;const qchars:Tcharset):string;
-
-    var i:byte;
-
-    begin
-      octal_quote:='';
-      for i:=1 to length(s) do
-        begin
-          if s[i] in qchars then
-            begin
-              if ord(s[i])<64 then
-                octal_quote:=octal_quote+'\'+octstr(ord(s[i]),3)
-              else
-                octal_quote:=octal_quote+'\'+octstr(ord(s[i]),4);
-            end
-          else
-            octal_quote:=octal_quote+s[i];
-        end;
-    end;
-
-    function maybequoted(const s:string):string;
-      var
-        s1 : string;
-        i  : integer;
-        quoted : boolean;
-      begin
-        quoted:=false;
-        s1:='"';
-        for i:=1 to length(s) do
-         begin
-           case s[i] of
-             '"' :
-               begin
-                 quoted:=true;
-                 s1:=s1+'\"';
-               end;
-             ' ',
-             #128..#255 :
-               begin
-                 quoted:=true;
-                 s1:=s1+s[i];
-               end;
-             else
-               s1:=s1+s[i];
-           end;
-         end;
-        if quoted then
-          maybequoted:=s1+'"'
-        else
-          maybequoted:=s;
-      end;
-
-
-    function DePascalQuote(var s: string): Boolean;
-      var
-        destPos, sourcePos, len: Integer;
-        t: string;
-        ch: Char;
-    begin
-      DePascalQuote:= false;
-      len:= length(s);
-      if (len >= 1) and (s[1] = '''') then
-        begin
-          {Remove quotes, exchange '' against ' }
-          destPos := 0;
-          sourcepos:=1;
-          while (sourcepos<len) do
-            begin
-              inc(sourcePos);
-              ch := s[sourcePos];
-              if ch = '''' then
-                begin
-                  inc(sourcePos);
-                  if (sourcePos <= len) and (s[sourcePos] = '''') then
-                    {Add the quote as part of string}
-                  else
-                    begin
-                      SetLength(t, destPos);
-                      s:= t;
-                      Exit(true);
-                    end;
-                end;
-              inc(destPos);
-              t[destPos] := ch;
-            end;
-        end;
-    end;
-
-
-    function pchar2pstring(p : pchar) : pstring;
-      var
-         w,i : longint;
-      begin
-         w:=strlen(p);
-         for i:=w-1 downto 0 do
-           p[i+1]:=p[i];
-         p[0]:=chr(w);
-         pchar2pstring:=pstring(p);
-      end;
-
-
-    function pstring2pchar(p : pstring) : pchar;
-      var
-         w,i : longint;
-      begin
-         w:=length(p^);
-         for i:=1 to w do
-           p^[i-1]:=p^[i];
-         p^[w]:=#0;
-         pstring2pchar:=pchar(p);
-      end;
-
-
-    function lowercase(c : char) : char;
-       begin
-          case c of
-             #65..#90 : c := chr(ord (c) + 32);
-             #154 : c:=#129;  { german }
-             #142 : c:=#132;  { german }
-             #153 : c:=#148;  { german }
-             #144 : c:=#130;  { french }
-             #128 : c:=#135;  { french }
-             #143 : c:=#134;  { swedish/norge (?) }
-             #165 : c:=#164;  { spanish }
-             #228 : c:=#229;  { greek }
-             #226 : c:=#231;  { greek }
-             #232 : c:=#227;  { greek }
-          end;
-          lowercase := c;
-       end;
-
-
-    function strpnew(const s : string) : pchar;
-      var
-         p : pchar;
-      begin
-         getmem(p,length(s)+1);
-         strpcopy(p,s);
-         strpnew:=p;
-      end;
-
-
-    procedure strdispose(var p : pchar);
-      begin
-        if assigned(p) then
-         begin
-           freemem(p,strlen(p)+1);
-           p:=nil;
-         end;
-      end;
-
-
-    procedure stringdispose(var p : pstring);{$ifdef USEINLINE}inline;{$endif}
-      begin
-         if assigned(p) then
-           begin
-             freemem(p,length(p^)+1);
-             p:=nil;
-           end;
-      end;
-
-
-    function stringdup(const s : string) : pstring;{$ifdef USEINLINE}inline;{$endif}
-      begin
-         getmem(result,length(s)+1);
-         result^:=s;
-      end;
-
-
-    function CompareText(S1, S2: string): longint;
-      begin
-        UpperVar(S1);
-        UpperVar(S2);
-        if S1<S2 then
-         CompareText:=-1
-        else
-         if S1>S2 then
-          CompareText:= 1
-        else
-         CompareText:=0;
-      end;
-
-
-{*****************************************************************************
-                               GetSpeedValue
-*****************************************************************************}
-
-    var
-      Crc32Tbl : array[0..255] of cardinal;
-
-    procedure MakeCRC32Tbl;
-      var
-        crc : cardinal;
-        i,n : integer;
-      begin
-        for i:=0 to 255 do
-         begin
-           crc:=i;
-           for n:=1 to 8 do
-            if odd(longint(crc)) then
-             crc:=cardinal(crc shr 1) xor cardinal($edb88320)
-            else
-             crc:=cardinal(crc shr 1);
-           Crc32Tbl[i]:=crc;
-         end;
-      end;
-
-
-    Function GetSpeedValue(Const s:String):cardinal;
-      var
-        i : integer;
-        InitCrc : cardinal;
-      begin
-        InitCrc:=cardinal($ffffffff);
-        for i:=1 to Length(s) do
-         InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8);
-        GetSpeedValue:=InitCrc;
-      end;
-
-
-{*****************************************************************************
-                               Ansistring (PChar+Length)
-*****************************************************************************}
-
-    procedure ansistringdispose(var p : pchar;length : longint);
-      begin
-         if assigned(p) then
-           begin
-             freemem(p,length+1);
-             p:=nil;
-           end;
-      end;
-
-
-    { enable ansistring comparison }
-    { 0 means equal }
-    { 1 means p1 > p2 }
-    { -1 means p1 < p2 }
-    function compareansistrings(p1,p2 : pchar;length1,length2 :  longint) : longint;
-      var
-         i,j : longint;
-      begin
-         compareansistrings:=0;
-         j:=min(length1,length2);
-         i:=0;
-         while (i<j) do
-          begin
-            if p1[i]>p2[i] then
-             begin
-               compareansistrings:=1;
-               exit;
-             end
-            else
-             if p1[i]<p2[i] then
-              begin
-                compareansistrings:=-1;
-                exit;
-              end;
-            inc(i);
-          end;
-         if length1>length2 then
-          compareansistrings:=1
-         else
-          if length1<length2 then
-           compareansistrings:=-1;
-      end;
-
-
-    function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
-      var
-         p : pchar;
-      begin
-         getmem(p,length1+length2+1);
-         move(p1[0],p[0],length1);
-         move(p2[0],p[length1],length2+1);
-         concatansistrings:=p;
-      end;
-
-
-{*****************************************************************************
-                       Ultra basic KISS Lzw (de)compressor
-*****************************************************************************}
-
-    {This is an extremely basic implementation of the Lzw algorithm. It
-     compresses 7-bit ASCII strings into 8-bit compressed strings.
-     The Lzw dictionary is preinitialized with 0..127, therefore this
-     part of the dictionary does not need to be stored in the arrays.
-     The Lzw code size is allways 8 bit, so we do not need complex code
-     that can write partial bytes.}
-
-    function minilzw_encode(const s:string):string;
-
-    var t,u,i:byte;
-        c:char;
-        data:array[128..255] of char;
-        previous:array[128..255] of byte;
-        lzwptr:byte;
-        next_avail:set of 0..255;
-
-    label l1;
-
-    begin
-      minilzw_encode:='';
-      if s<>'' then
-        begin
-          lzwptr:=127;
-          t:=byte(s[1]);
-          i:=2;
-          u:=128;
-          next_avail:=[];
-          while i<=length(s) do
-            begin
-              c:=s[i];
-              if not(t in next_avail) or (u>lzwptr) then goto l1;
-              while (previous[u]<>t) or (data[u]<>c) do
-                begin
-                  inc(u);
-                  if u>lzwptr then goto l1;
-                end;
-              t:=u;
-              inc(i);
-              continue;
-            l1:
-              {It's a pity that we still need those awfull tricks
-               with this modern compiler. Without this performance
-               of the entire procedure drops about 3 times.}
-              inc(minilzw_encode[0]);
-              minilzw_encode[length(minilzw_encode)]:=char(t);
-              if lzwptr=255 then
-                begin
-                  lzwptr:=127;
-                  next_avail:=[];
-                end
-              else
-                begin
-                  inc(lzwptr);
-                  data[lzwptr]:=c;
-                  previous[lzwptr]:=t;
-                  include(next_avail,t);
-                end;
-              t:=byte(c);
-              u:=128;
-              inc(i);
-            end;
-          inc(minilzw_encode[0]);
-          minilzw_encode[length(minilzw_encode)]:=char(t);
-        end;
-    end;
-
-    function minilzw_decode(const s:string):string;
-
-    var oldc,newc,c:char;
-        i,j:byte;
-        data:array[128..255] of char;
-        previous:array[128..255] of byte;
-        lzwptr:byte;
-        t:string;
-
-    begin
-      minilzw_decode:='';
-      if s<>'' then
-        begin
-          lzwptr:=127;
-          oldc:=s[1];
-          c:=oldc;
-          i:=2;
-          minilzw_decode:=oldc;
-          while i<=length(s) do
-            begin
-              newc:=s[i];
-              if byte(newc)>lzwptr then
-                begin
-                  t:=c;
-                  c:=oldc;
-                end
-              else
-                begin
-                  c:=newc;
-                  t:='';
-                end;
-              while c>=#128 do
-                begin
-                  inc(t[0]);
-                  t[length(t)]:=data[byte(c)];
-                  byte(c):=previous[byte(c)];
-                end;
-              inc(minilzw_decode[0]);
-              minilzw_decode[length(minilzw_decode)]:=c;
-              for j:=length(t) downto 1 do
-                begin
-                  inc(minilzw_decode[0]);
-                  minilzw_decode[length(minilzw_decode)]:=t[j];
-                end;
-              if lzwptr=255 then
-                lzwptr:=127
-              else
-                begin
-                  inc(lzwptr);
-                  previous[lzwptr]:=byte(oldc);
-                  data[lzwptr]:=c;
-                end;
-              oldc:=newc;
-              inc(i);
-            end;
-        end;
-    end;
-
-
-    procedure defaulterror(i:longint);
-      begin
-        writeln('Internal error ',i);
-        runerror(255);
-      end;
-
-
-initialization
-  internalerrorproc:=@defaulterror;
-  makecrc32tbl;
-  initupperlower;
-end.

compiler/compiler/dbgbase.pas

@@ -1,128 +0,0 @@
-{
-    Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
-
-    This units contains support for debug info generation
-
-    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 dbgbase;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      systems,
-      symdef,symtype,
-      symsym,
-      aasmtai;
-
-    type
-      TDebugInfo=class
-        constructor Create;virtual;
-        procedure inserttypeinfo;virtual;
-        procedure insertmoduleinfo;virtual;
-        procedure insertlineinfo(list:taasmoutput);virtual;
-        procedure referencesections(list:taasmoutput);virtual;
-      end;
-      TDebugInfoClass=class of TDebugInfo;
-
-    var
-      CDebugInfo : array[tdbg] of TDebugInfoClass;
-      DebugInfo  : TDebugInfo;
-
-    procedure InitDebugInfo;
-    procedure DoneDebugInfo;
-    procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass);
-
-
-implementation
-
-    uses
-      verbose;
-
-
-    constructor tdebuginfo.Create;
-      begin
-      end;
-
-
-    procedure tdebuginfo.insertmoduleinfo;
-      begin
-      end;
-
-
-    procedure tdebuginfo.inserttypeinfo;
-      begin
-      end;
-
-
-    procedure tdebuginfo.insertlineinfo(list:taasmoutput);
-      begin
-      end;
-
-
-    procedure tdebuginfo.referencesections(list:taasmoutput);
-      begin
-      end;
-
-
-    procedure InitDebugInfo;
-      begin
-        if not assigned(CDebugInfo[target_dbg.id]) then
-          begin
-            Comment(V_Fatal,'cg_f_debuginfo_output_not_supported');
-            exit;
-          end;
-        DebugInfo:=CDebugInfo[target_dbg.id].Create;
-      end;
-
-
-    procedure DoneDebugInfo;
-      begin
-        if assigned(DebugInfo) then
-          begin
-            DebugInfo.Free;
-            DebugInfo:=nil;
-          end;
-      end;
-
-
-    procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass);
-      var
-        t : tdbg;
-      begin
-        t:=r.id;
-        if assigned(dbginfos[t]) then
-          writeln('Warning: DebugInfo is already registered!')
-        else
-          Getmem(dbginfos[t],sizeof(tdbginfo));
-        dbginfos[t]^:=r;
-        CDebugInfo[t]:=c;
-      end;
-
-
-    const
-      dbg_none_info : tdbginfo =
-         (
-           id     : dbg_none;
-           idtxt  : 'NONE';
-         );
-
-initialization
-  RegisterDebugInfo(dbg_none_info,tdebuginfo);
-end.

compiler/compiler/dbgdwarf.pas

@@ -1,49 +0,0 @@
-{
-    Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
-
-    This units contains support for DWARF debug info generation
-
-    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 dbgdwarf;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      DbgBase;
-
-    type
-      TDebugInfoDwarf=class(TDebugInfo)
-      end;
-
-implementation
-
-    uses
-      Systems;
-
-    const
-      dbg_dwarf_info : tdbginfo =
-         (
-           id     : dbg_dwarf;
-           idtxt  : 'DWARF';
-         );
-
-initialization
-  RegisterDebugInfo(dbg_dwarf_info,TDebugInfoDwarf);
-end.

compiler/compiler/dbgstabs.pas

@@ -1,1589 +0,0 @@
-{
-    Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
-
-    This units contains support for STABS debug info generation
-
-    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 dbgstabs;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-      cclasses,
-      dbgbase,
-      symtype,symdef,symsym,symtable,symbase,
-      aasmtai;
-
-    type
-      TDebugInfoStabs=class(TDebugInfo)
-      private
-        writing_def_stabs  : boolean;
-        global_stab_number : word;
-        defnumberlist      : tlist;
-        { tsym writing }
-        function  sym_var_value(const s:string;arg:pointer):string;
-        function  sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):Pchar;
-        procedure write_symtable_syms(list:taasmoutput;st:tsymtable);
-        { tdef writing }
-        function  def_stab_number(def:tdef):string;
-        function  def_stab_classnumber(def:tobjectdef):string;
-        function  def_var_value(const s:string;arg:pointer):string;
-        function  def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):Pchar;
-        procedure field_add_stabstr(p:Tnamedindexitem;arg:pointer);
-        procedure method_add_stabstr(p:Tnamedindexitem;arg:pointer);
-        function  def_stabstr(def:tdef):pchar;
-        procedure write_def_stabstr(list:taasmoutput;def:tdef);
-        procedure field_write_defs(p:Tnamedindexitem;arg:pointer);
-        procedure method_write_defs(p :tnamedindexitem;arg:pointer);
-        procedure write_symtable_defs(list:taasmoutput;st:tsymtable);
-        procedure write_procdef(list:taasmoutput;pd:tprocdef);
-        procedure insertsym(list:taasmoutput;sym:tsym);
-        procedure insertdef(list:taasmoutput;def:tdef);
-      public
-        procedure inserttypeinfo;override;
-        procedure insertmoduleinfo;override;
-        procedure insertlineinfo(list:taasmoutput);override;
-        procedure referencesections(list:taasmoutput);override;
-      end;
-
-
-implementation
-
-    uses
-      strings,cutils,
-      systems,globals,globtype,verbose,
-      symconst,defutil,
-      cpuinfo,cpubase,cgbase,paramgr,
-      aasmbase,procinfo,
-      finput,fmodule,ppu;
-
-    const
-      memsizeinc = 512;
-
-      N_GSYM = $20;
-      N_STSYM = 38;     { initialized const }
-      N_LCSYM = 40;     { non initialized variable}
-      N_Function = $24; { function or const }
-      N_TextLine = $44;
-      N_DataLine = $46;
-      N_BssLine = $48;
-      N_RSYM = $40;     { register variable }
-      N_LSYM = $80;
-      N_tsym = 160;
-      N_SourceFile = $64;
-      N_IncludeFile = $84;
-      N_BINCL = $82;
-      N_EINCL = $A2;
-      N_EXCL  = $C2;
-
-      tagtypes = [
-        recorddef,
-        enumdef,
-        stringdef,
-        filedef,
-        objectdef
-      ];
-
-    type
-       get_var_value_proc=function(const s:string;arg:pointer):string of object;
-
-       Trecord_stabgen_state=record
-          stabstring:Pchar;
-          stabsize,staballoc,recoffset:integer;
-       end;
-       Precord_stabgen_state=^Trecord_stabgen_state;
-
-
-    function string_evaluate(s:string;get_var_value:get_var_value_proc;
-                             get_var_value_arg:pointer;
-                             const vars:array of string):Pchar;
-
-    (*
-     S contains a prototype of a result. Stabstr_evaluate will expand
-     variables and parameters.
-
-     Output is s in ASCIIZ format, with the following expanded:
-
-     ${varname}   - The variable name is expanded.
-     $n           - The parameter n is expanded.
-     $$           - Is expanded to $
-    *)
-
-    const maxvalue=9;
-          maxdata=1023;
-
-    var i,j:byte;
-        varname:string[63];
-        varno,varcounter:byte;
-        varvalues:array[0..9] of Pstring;
-        {1 kb of parameters is the limit. 256 extra bytes are allocated to
-         ensure buffer integrity.}
-        varvaluedata:array[0..maxdata+256] of char;
-        varptr:Pchar;
-        varidx : byte;
-        len:cardinal;
-        r:Pchar;
-
-    begin
-      {Two pass approach, first, calculate the length and receive variables.}
-      i:=1;
-      len:=0;
-      varcounter:=0;
-      varptr:=@varvaluedata;
-      while i<=length(s) do
-        begin
-          if (s[i]='$') and (i<length(s)) then
-            begin
-             if s[i+1]='$' then
-               begin
-                 inc(len);
-                 inc(i);
-               end
-             else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
-               begin
-                 varname:='';
-                 inc(i,2);
-                 repeat
-                   inc(varname[0]);
-                   varname[length(varname)]:=s[i];
-                   s[i]:=char(varcounter);
-                   inc(i);
-                 until s[i]='}';
-                 varvalues[varcounter]:=Pstring(varptr);
-                 if varptr>@varvaluedata+maxdata then
-                   internalerrorproc(200411152);
-                 Pstring(varptr)^:=get_var_value(varname,get_var_value_arg);
-                 inc(len,length(Pstring(varptr)^));
-                 inc(varptr,length(Pstring(varptr)^)+1);
-                 inc(varcounter);
-               end
-             else if s[i+1] in ['1'..'9'] then
-               begin
-                 varidx:=byte(s[i+1])-byte('1');
-                 if varidx>high(vars) then
-                   internalerror(200509263);
-                 inc(len,length(vars[varidx]));
-                 inc(i);
-               end;
-            end
-          else
-            inc(len);
-          inc(i);
-        end;
-
-      {Second pass, writeout result.}
-      getmem(r,len+1);
-      string_evaluate:=r;
-      i:=1;
-      while i<=length(s) do
-        begin
-          if (s[i]='$') and (i<length(s)) then
-            begin
-             if s[i+1]='$' then
-               begin
-                 r^:='$';
-                 inc(r);
-                 inc(i);
-               end
-             else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
-               begin
-                 varname:='';
-                 inc(i,2);
-                 varno:=byte(s[i]);
-                 repeat
-                   inc(i);
-                 until s[i]='}';
-                 for j:=1 to length(varvalues[varno]^) do
-                   begin
-                     r^:=varvalues[varno]^[j];
-                     inc(r);
-                   end;
-               end
-             else if s[i+1] in ['0'..'9'] then
-               begin
-                 for j:=1 to length(vars[byte(s[i+1])-byte('1')]) do
-                   begin
-                     r^:=vars[byte(s[i+1])-byte('1')][j];
-                     inc(r);
-                   end;
-                 inc(i);
-               end
-            end
-          else
-            begin
-              r^:=s[i];
-              inc(r);
-            end;
-          inc(i);
-        end;
-      r^:=#0;
-    end;
-
-
-{****************************************************************************
-                               TDef support
-****************************************************************************}
-
-    function TDebugInfoStabs.def_stab_number(def:tdef):string;
-      begin
-        { procdefs only need a number, mark them as already written
-          so they won't be written implicitly }
-        if (def.deftype=procdef) then
-          def.stab_state:=stab_state_written;
-        { Stab must already be written, or we must be busy writing it }
-        if writing_def_stabs and
-           not(def.stab_state in [stab_state_writing,stab_state_written]) then
-          internalerror(200403091);
-        { Keep track of used stabs, this info is only usefull for stabs
-          referenced by the symbols. Definitions will always include all
-          required stabs }
-        if def.stab_state=stab_state_unused then
-          def.stab_state:=stab_state_used;
-        { Need a new number? }
-        if def.stab_number=0 then
-          begin
-            inc(global_stab_number);
-            { classes require 2 numbers }
-            if is_class(def) then
-              inc(global_stab_number);
-            def.stab_number:=global_stab_number;
-            if global_stab_number>=defnumberlist.count then
-              defnumberlist.count:=global_stab_number+250;
-            defnumberlist[global_stab_number]:=def;
-          end;
-        result:=tostr(def.stab_number);
-      end;
-
-
-    function TDebugInfoStabs.def_stab_classnumber(def:tobjectdef):string;
-      begin
-        if def.stab_number=0 then
-          def_stab_number(def);
-        result:=tostr(def.stab_number-1);
-      end;
-
-
-    function TDebugInfoStabs.def_var_value(const s:string;arg:pointer):string;
-      var
-        def : tdef;
-      begin
-        def:=tdef(arg);
-        result:='';
-        if s='numberstring' then
-          result:=def_stab_number(def)
-        else if s='sym_name' then
-          begin
-            if assigned(def.typesym) then
-               result:=Ttypesym(def.typesym).name;
-          end
-        else if s='N_LSYM' then
-          result:=tostr(N_LSYM)
-        else if s='savesize' then
-          result:=tostr(def.size);
-      end;
-
-
-    function TDebugInfoStabs.def_stabstr_evaluate(def:tdef;const s:string;const vars:array of string):Pchar;
-      begin
-        result:=string_evaluate(s,@def_var_value,def,vars);
-      end;
-
-
-    procedure TDebugInfoStabs.field_add_stabstr(p:Tnamedindexitem;arg:pointer);
-      var
-        newrec  : Pchar;
-        spec    : string[3];
-        varsize : aint;
-        state   : Precord_stabgen_state;
-      begin
-        state:=arg;
-        { static variables from objects are like global objects }
-        if (Tsym(p).typ=fieldvarsym) and
-           not(sp_static in Tsym(p).symoptions) then
-          begin
-            if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
-              spec:='/1'
-            else if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
-              spec:='/0'
-            else
-              spec:='';
-            varsize:=tfieldvarsym(p).vartype.def.size;
-            { open arrays made overflows !! }
-            if varsize>$fffffff then
-              varsize:=$fffffff;
-            newrec:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[p.name,
-                                     spec+def_stab_number(tfieldvarsym(p).vartype.def),
-                                     tostr(tfieldvarsym(p).fieldoffset*8),tostr(varsize*8)]);
-            if state^.stabsize+strlen(newrec)>=state^.staballoc-256 then
-              begin
-                inc(state^.staballoc,strlen(newrec)+64);
-                reallocmem(state^.stabstring,state^.staballoc);
-              end;
-            strcopy(state^.stabstring+state^.stabsize,newrec);
-            inc(state^.stabsize,strlen(newrec));
-            strdispose(newrec);
-            {This should be used for case !!}
-            inc(state^.recoffset,Tfieldvarsym(p).vartype.def.size);
-          end;
-      end;
-
-
-    procedure TDebugInfoStabs.method_add_stabstr(p:Tnamedindexitem;arg:pointer);
-      var virtualind,argnames : string;
-          newrec : pchar;
-          pd     : tprocdef;
-          lindex : longint;
-          arglength : byte;
-          sp : char;
-          state:^Trecord_stabgen_state;
-          olds:integer;
-          i : integer;
-          parasym : tparavarsym;
-      begin
-        state:=arg;
-        if tsym(p).typ = procsym then
-         begin
-           pd := tprocsym(p).first_procdef;
-           if (po_virtualmethod in pd.procoptions) then
-             begin
-               lindex := pd.extnumber;
-               {doesnt seem to be necessary
-               lindex := lindex or $80000000;}
-               virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd._class)+';'
-             end
-            else
-             virtualind := '.';
-
-            { used by gdbpas to recognize constructor and destructors }
-            if (pd.proctypeoption=potype_constructor) then
-              argnames:='__ct__'
-            else if (pd.proctypeoption=potype_destructor) then
-              argnames:='__dt__'
-            else
-              argnames := '';
-
-           { arguments are not listed here }
-           {we don't need another definition}
-            for i:=0 to pd.paras.count-1 do
-              begin
-                parasym:=tparavarsym(pd.paras[i]);
-                if Parasym.vartype.def.deftype = formaldef then
-                  begin
-                    case Parasym.varspez of
-                      vs_var :
-                        argnames := argnames+'3var';
-                      vs_const :
-                        argnames:=argnames+'5const';
-                      vs_out :
-                        argnames:=argnames+'3out';
-                    end;
-                  end
-                else
-                  begin
-                    { if the arg definition is like (v: ^byte;..
-                    there is no sym attached to data !!! }
-                    if assigned(Parasym.vartype.def.typesym) then
-                      begin
-                        arglength := length(Parasym.vartype.def.typesym.name);
-                        argnames := argnames + tostr(arglength)+Parasym.vartype.def.typesym.name;
-                      end
-                    else
-                      argnames:=argnames+'11unnamedtype';
-                  end;
-              end;
-           { here 2A must be changed for private and protected }
-           { 0 is private 1 protected and 2 public }
-           if ([sp_private,sp_strictprivate]*tsym(p).symoptions)<>[] then
-             sp:='0'
-           else if ([sp_protected,sp_strictprotected]*tsym(p).symoptions)<>[] then
-             sp:='1'
-           else
-             sp:='2';
-           newrec:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[p.name,def_stab_number(pd),
-                                    def_stab_number(pd.rettype.def),argnames,sp,
-                                    virtualind]);
-           { get spare place for a string at the end }
-           olds:=state^.stabsize;
-           inc(state^.stabsize,strlen(newrec));
-           if state^.stabsize>=state^.staballoc-256 then
-             begin
-                inc(state^.staballoc,strlen(newrec)+64);
-                reallocmem(state^.stabstring,state^.staballoc);
-             end;
-           strcopy(state^.stabstring+olds,newrec);
-           strdispose(newrec);
-           {This should be used for case !!
-           RecOffset := RecOffset + pd.size;}
-         end;
-      end;
-
-
-    function TDebugInfoStabs.def_stabstr(def:tdef):pchar;
-
-        function stringdef_stabstr(def:tstringdef):pchar;
-          var
-            slen : aint;
-            bytest,charst,longst : string;
-          begin
-            case def.string_typ of
-              st_shortstring:
-                begin
-                  { fix length of openshortstring }
-                  slen:=def.len;
-                  if slen=0 then
-                    slen:=255;
-                  charst:=def_stab_number(cchartype.def);
-                  bytest:=def_stab_number(u8inttype.def);
-                  result:=def_stabstr_evaluate(def,'s$1length:$2,0,8;st:ar$2;1;$3;$4,8,$5;;',
-                              [tostr(slen+1),bytest,tostr(slen),charst,tostr(slen*8)]);
-                end;
-              st_longstring:
-                begin
-                  charst:=def_stab_number(cchartype.def);
-                  bytest:=def_stab_number(u8inttype.def);
-                  longst:=def_stab_number(u32inttype.def);
-                  result:=def_stabstr_evaluate(def,'s$1length:$2,0,32;dummy:$6,32,8;st:ar$2;1;$3;$4,40,$5;;',
-                              [tostr(def.len+5),longst,tostr(def.len),charst,tostr(def.len*8),bytest]);
-               end;
-             st_ansistring:
-               begin
-                 { looks like a pchar }
-                 charst:=def_stab_number(cchartype.def);
-                 result:=strpnew('*'+charst);
-               end;
-             st_widestring:
-               begin
-                 { looks like a pwidechar }
-                 charst:=def_stab_number(cwidechartype.def);
-                 result:=strpnew('*'+charst);
-               end;
-            end;
-          end;
-
-        function enumdef_stabstr(def:tenumdef):pchar;
-          var
-            st : Pchar;
-            p : Tenumsym;
-            s : string;
-            memsize,
-            stl : aint;
-          begin
-            memsize:=memsizeinc;
-            getmem(st,memsize);
-            { we can specify the size with @s<size>; prefix PM }
-            if def.size <> std_param_align then
-              strpcopy(st,'@s'+tostr(def.size*8)+';e')
-            else
-              strpcopy(st,'e');
-            p := tenumsym(def.firstenum);
-            stl:=strlen(st);
-            while assigned(p) do
-              begin
-                s :=p.name+':'+tostr(p.value)+',';
-                { place for the ending ';' also }
-                if (stl+length(s)+1>=memsize) then
-                  begin
-                    inc(memsize,memsizeinc);
-                    reallocmem(st,memsize);
-                  end;
-                strpcopy(st+stl,s);
-                inc(stl,length(s));
-                p:=p.nextenum;
-              end;
-            st[stl]:=';';
-            st[stl+1]:=#0;
-            reallocmem(st,stl+2);
-            result:=st;
-          end;
-
-        function orddef_stabstr(def:torddef):pchar;
-          begin
-            if cs_gdb_valgrind in aktglobalswitches then
-              begin
-                case def.typ of
-                  uvoid :
-                    result:=strpnew(def_stab_number(def));
-                  bool8bit,
-                  bool16bit,
-                  bool32bit :
-                    result:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]);
-                  u32bit,
-                  s64bit,
-                  u64bit :
-                    result:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]);
-                  else
-                    result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]);
-                end;
-              end
-            else
-              begin
-                case def.typ of
-                  uvoid :
-                    result:=strpnew(def_stab_number(def));
-                  uchar :
-                    result:=strpnew('-20;');
-                  uwidechar :
-                    result:=strpnew('-30;');
-                  bool8bit :
-                    result:=strpnew('-21;');
-                  bool16bit :
-                    result:=strpnew('-22;');
-                  bool32bit :
-                    result:=strpnew('-23;');
-                  u64bit :
-                    result:=strpnew('-32;');
-                  s64bit :
-                    result:=strpnew('-31;');
-                  {u32bit : result:=def_stab_number(s32inttype.def)+';0;-1;'); }
-                  else
-                    result:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low)),tostr(longint(def.high))]);
-                end;
-             end;
-          end;
-
-        function floatdef_stabstr(def:tfloatdef):Pchar;
-          begin
-            case def.typ of
-              s32real,
-              s64real,
-              s80real:
-                result:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype.def)]);
-              s64currency,
-              s64comp:
-                result:=def_stabstr_evaluate(def,'r$1;-${savesize};0;',[def_stab_number(s32inttype.def)]);
-              else
-                internalerror(200509261);
-            end;
-          end;
-
-        function filedef_stabstr(def:tfiledef):pchar;
-          begin
-{$ifdef cpu64bit}
-            result:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$2,64,64;'+
-                                     '_PRIVATE:ar$1;1;64;$3,128,256;USERDATA:ar$1;1;16;$3,384,128;'+
-                                     'NAME:ar$1;0;255;$4,512,2048;;',[def_stab_number(s32inttype.def),
-                                     def_stab_number(s64inttype.def),
-                                     def_stab_number(u8inttype.def),
-                                     def_stab_number(cchartype.def)]);
-{$else cpu64bit}
-            result:=def_stabstr_evaluate(def,'s${savesize}HANDLE:$1,0,32;MODE:$1,32,32;RECSIZE:$1,64,32;'+
-                                     '_PRIVATE:ar$1;1;32;$3,96,256;USERDATA:ar$1;1;16;$2,352,128;'+
-                                     'NAME:ar$1;0;255;$3,480,2048;;',[def_stab_number(s32inttype.def),
-                                     def_stab_number(u8inttype.def),
-                                     def_stab_number(cchartype.def)]);
-{$endif cpu64bit}
-          end;
-
-        function procdef_stabstr(def:tprocdef):pchar;
-          Var
-            RType : Char;
-            Obj,Info : String;
-            stabsstr : string;
-            p : pchar;
-          begin
-            obj := def.procsym.name;
-            info := '';
-            if (po_global in def.procoptions) then
-              RType := 'F'
-            else
-              RType := 'f';
-            if assigned(def.owner) then
-             begin
-               if (def.owner.symtabletype = objectsymtable) then
-                 obj := def.owner.name^+'__'+def.procsym.name;
-               if not(cs_gdb_valgrind in aktglobalswitches) and
-                  (def.owner.symtabletype=localsymtable) and
-                  assigned(def.owner.defowner) and
-                  assigned(tprocdef(def.owner.defowner).procsym) then
-                 info := ','+def.procsym.name+','+tprocdef(def.owner.defowner).procsym.name;
-             end;
-            stabsstr:=def.mangledname;
-            getmem(p,length(stabsstr)+255);
-            strpcopy(p,'"'+obj+':'+RType
-                  +def_stab_number(def.rettype.def)+info+'",'+tostr(n_function)
-                  +',0,'+
-                  tostr(def.fileinfo.line)
-                  +',');
-            strpcopy(strend(p),stabsstr);
-            result:=strnew(p);
-            freemem(p,length(stabsstr)+255);
-          end;
-
-        function recorddef_stabstr(def:trecorddef):pchar;
-          var
-            state : Trecord_stabgen_state;
-          begin
-            getmem(state.stabstring,memsizeinc);
-            state.staballoc:=memsizeinc;
-            strpcopy(state.stabstring,'s'+tostr(def.size));
-            state.recoffset:=0;
-            state.stabsize:=strlen(state.stabstring);
-            def.symtable.foreach(@field_add_stabstr,@state);
-            state.stabstring[state.stabsize]:=';';
-            state.stabstring[state.stabsize+1]:=#0;
-            reallocmem(state.stabstring,state.stabsize+2);
-            result:=state.stabstring;
-          end;
-
-        function objectdef_stabstr(def:tobjectdef):pchar;
-          var
-            anc    : tobjectdef;
-            state  :Trecord_stabgen_state;
-            ts     : string;
-          begin
-            { Write the invisible pointer for the class? }
-            if (def.objecttype=odt_class) and
-               (not def.writing_class_record_stab) then
-              begin
-                result:=strpnew('*'+def_stab_classnumber(def));
-                exit;
-              end;
-
-            state.staballoc:=memsizeinc;
-            getmem(state.stabstring,state.staballoc);
-            strpcopy(state.stabstring,'s'+tostr(tobjectsymtable(def.symtable).datasize));
-            if assigned(def.childof) then
-              begin
-                {only one ancestor not virtual, public, at base offset 0 }
-                {       !1           ,    0       2         0    ,       }
-                strpcopy(strend(state.stabstring),'!1,020,'+def_stab_classnumber(def.childof)+';');
-              end;
-            {virtual table to implement yet}
-            state.recoffset:=0;
-            state.stabsize:=strlen(state.stabstring);
-            def.symtable.foreach(@field_add_stabstr,@state);
-            if (oo_has_vmt in def.objectoptions) then
-              if not assigned(def.childof) or not(oo_has_vmt in def.childof.objectoptions) then
-                 begin
-                    ts:='$vf'+def_stab_classnumber(def)+':'+def_stab_number(vmtarraytype.def)+','+tostr(def.vmt_offset*8)+';';
-                    strpcopy(state.stabstring+state.stabsize,ts);
-                    inc(state.stabsize,length(ts));
-                 end;
-            def.symtable.foreach(@method_add_stabstr,@state);
-            if (oo_has_vmt in def.objectoptions) then
-              begin
-                 anc := def;
-                 while assigned(anc.childof) and (oo_has_vmt in anc.childof.objectoptions) do
-                   anc := anc.childof;
-                 { just in case anc = self }
-                 ts:=';~%'+def_stab_classnumber(anc)+';';
-              end
-            else
-              ts:=';';
-            strpcopy(state.stabstring+state.stabsize,ts);
-            inc(state.stabsize,length(ts));
-            reallocmem(state.stabstring,state.stabsize+1);
-            result:=state.stabstring;
-          end;
-
-      begin
-        result:=nil;
-        case def.deftype of
-          stringdef :
-            result:=stringdef_stabstr(tstringdef(def));
-          enumdef :
-            result:=enumdef_stabstr(tenumdef(def));
-          orddef :
-            result:=orddef_stabstr(torddef(def));
-          floatdef :
-            result:=floatdef_stabstr(tfloatdef(def));
-          filedef :
-            result:=filedef_stabstr(tfiledef(def));
-          recorddef :
-            result:=recorddef_stabstr(trecorddef(def));
-          variantdef :
-            result:=def_stabstr_evaluate(def,'formal${numberstring};',[]);
-          pointerdef :
-            result:=strpnew('*'+def_stab_number(tpointerdef(def).pointertype.def));
-          classrefdef :
-            result:=strpnew(def_stab_number(pvmttype.def));
-          setdef :
-            result:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),def_stab_number(tsetdef(def).elementtype.def)]);
-          formaldef :
-            result:=def_stabstr_evaluate(def,'formal${numberstring};',[]);
-          arraydef :
-            result:=def_stabstr_evaluate(def,'ar$1;$2;$3;$4',[def_stab_number(tarraydef(def).rangetype.def),
-               tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementtype.def)]);
-          procdef :
-            result:=procdef_stabstr(tprocdef(def));
-          procvardef :
-            result:=strpnew('*f'+def_stab_number(tprocvardef(def).rettype.def));
-          objectdef :
-            begin
-              if tobjectdef(def).writing_class_record_stab then
-                result:=objectdef_stabstr(tobjectdef(def))
-              else
-                result:=strpnew('*'+def_stab_classnumber(tobjectdef(def)));
-            end;
-        end;
-      end;
-
-
-    procedure TDebugInfoStabs.write_def_stabstr(list:taasmoutput;def:tdef);
-      var
-        stabchar : string[2];
-        ss,st,su : pchar;
-      begin
-        { procdefs require a different stabs style without type prefix }
-        if def.deftype=procdef then
-          begin
-            st:=def_stabstr(def);
-            { add to list }
-            list.concat(Tai_stab.create(stab_stabs,st));
-          end
-        else
-          begin
-            { type prefix }
-            if def.deftype in tagtypes then
-              stabchar := 'Tt'
-            else
-              stabchar := 't';
-            { Here we maybe generate a type, so we have to use numberstring }
-            if is_class(def) and
-               tobjectdef(def).writing_class_record_stab then
-              st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))])
-            else
-              st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_number(def)]);
-            ss:=def_stabstr(def);
-            reallocmem(st,strlen(ss)+512);
-            { line info is set to 0 for all defs, because the def can be in an other
-              unit and then the linenumber is invalid in the current sourcefile }
-            su:=def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]);
-            strcopy(strecopy(strend(st),ss),su);
-            reallocmem(st,strlen(st)+1);
-            strdispose(ss);
-            strdispose(su);
-            { add to list }
-            list.concat(Tai_stab.create(stab_stabs,st));
-          end;
-      end;
-
-
-    procedure TDebugInfoStabs.field_write_defs(p:Tnamedindexitem;arg:pointer);
-      begin
-        if (Tsym(p).typ=fieldvarsym) and
-           not(sp_static in Tsym(p).symoptions) then
-          insertdef(taasmoutput(arg),tfieldvarsym(p).vartype.def);
-      end;
-
-
-    procedure TDebugInfoStabs.method_write_defs(p :tnamedindexitem;arg:pointer);
-      var
-        pd : tprocdef;
-      begin
-        if tsym(p).typ = procsym then
-          begin
-            pd:=tprocsym(p).first_procdef;
-            insertdef(taasmoutput(arg),pd.rettype.def);
-          end;
-      end;
-
-
-    procedure TDebugInfoStabs.insertdef(list:taasmoutput;def:tdef);
-      var
-        anc : tobjectdef;
-        oldtypesym : tsym;
-//        nb  : string[12];
-      begin
-        if (def.stab_state in [stab_state_writing,stab_state_written]) then
-          exit;
-        { to avoid infinite loops }
-        def.stab_state := stab_state_writing;
-        { write dependencies first }
-        case def.deftype of
-          stringdef :
-            begin
-              if tstringdef(def).string_typ=st_widestring then
-                insertdef(list,cwidechartype.def)
-              else
-                begin
-                  insertdef(list,cchartype.def);
-                  insertdef(list,u8inttype.def);
-                end;
-            end;
-          floatdef :
-            insertdef(list,s32inttype.def);
-          filedef :
-            begin
-              insertdef(list,s32inttype.def);
-{$ifdef cpu64bit}
-              insertdef(list,s64inttype.def);
-{$endif cpu64bit}
-              insertdef(list,u8inttype.def);
-              insertdef(list,cchartype.def);
-            end;
-          classrefdef :
-            insertdef(list,pvmttype.def);
-          pointerdef :
-            insertdef(list,tpointerdef(def).pointertype.def);
-          setdef :
-            insertdef(list,tsetdef(def).elementtype.def);
-          procvardef,
-          procdef :
-            insertdef(list,tprocdef(def).rettype.def);
-          arraydef :
-            begin
-              insertdef(list,tarraydef(def).rangetype.def);
-              insertdef(list,tarraydef(def).elementtype.def);
-            end;
-          recorddef :
-            trecorddef(def).symtable.foreach(@field_write_defs,list);
-          objectdef :
-            begin
-              insertdef(list,vmtarraytype.def);
-              { first the parents }
-              anc:=tobjectdef(def);
-              while assigned(anc.childof) do
-                begin
-                  anc:=anc.childof;
-                  insertdef(list,anc);
-                end;
-              tobjectdef(def).symtable.foreach(@field_write_defs,list);
-              tobjectdef(def).symtable.foreach(@method_write_defs,list);
-            end;
-        end;
-(*
-        { Handle pointerdefs to records and objects to avoid recursion }
-        if (def.deftype=pointerdef) and
-           (tpointerdef(def).pointertype.def.deftype in [recorddef,objectdef]) then
-          begin
-            def.stab_state:=stab_state_used;
-            write_def_stabstr(list,def);
-            {to avoid infinite recursion in record with next-like fields }
-            if tdef(tpointerdef(def).pointertype.def).stab_state=stab_state_writing then
-              begin
-                if assigned(tpointerdef(def).pointertype.def.typesym) then
-                  begin
-                    if is_class(tpointerdef(def).pointertype.def) then
-                      nb:=def_stab_classnumber(tobjectdef(tpointerdef(def).pointertype.def))
-                    else
-                      nb:=def_stab_number(tpointerdef(def).pointertype.def);
-                    list.concat(Tai_stab.create(stab_stabs,def_stabstr_evaluate(
-                            def,'"${sym_name}:t${numberstring}=*$1=xs$2:",${N_LSYM},0,0,0',
-                            [nb,tpointerdef(def).pointertype.def.typesym.name])));
-                  end;
-                def.stab_state:=stab_state_written;
-              end
-          end
-        else
-*)
-        case def.deftype of
-          objectdef :
-            begin
-              { classes require special code to write the record and the invisible pointer }
-              if is_class(def) then
-                begin
-                  { Write the record class itself }
-                  tobjectdef(def).writing_class_record_stab:=true;
-                  write_def_stabstr(list,def);
-                  tobjectdef(def).writing_class_record_stab:=false;
-                  { Write the invisible pointer class }
-                  oldtypesym:=def.typesym;
-                  def.typesym:=nil;
-                  write_def_stabstr(list,def);
-                  def.typesym:=oldtypesym;
-                end
-              else
-                write_def_stabstr(list,def);
-              { VMT symbol }
-              if (oo_has_vmt in tobjectdef(def).objectoptions) and
-                 assigned(def.owner) and
-                 assigned(def.owner.name) then
-                list.concat(Tai_stab.create(stab_stabs,strpnew('"vmt_'+def.owner.name^+tobjectdef(def).name+':S'+
-                       def_stab_number(vmttype.def)+'",'+tostr(N_STSYM)+',0,0,'+tobjectdef(def).vmt_mangledname)));
-            end;
-          procdef :
-            begin
-              { procdefs are handled separatly }
-            end;
-          else
-            write_def_stabstr(list,def);
-        end;
-
-        def.stab_state := stab_state_written;
-      end;
-
-
-    procedure TDebugInfoStabs.write_symtable_defs(list:taasmoutput;st:tsymtable);
-
-       procedure dowritestabs(list:taasmoutput;st:tsymtable);
-         var
-           p : tdef;
-         begin
-           p:=tdef(st.defindex.first);
-           while assigned(p) do
-             begin
-               if (p.stab_state=stab_state_used) then
-                 insertdef(list,p);
-               p:=tdef(p.indexnext);
-             end;
-         end;
-
-      var
-        old_writing_def_stabs : boolean;
-      begin
-        case st.symtabletype of
-          staticsymtable :
-            list.concat(tai_comment.Create(strpnew('Defs - Begin Staticsymtable')));
-          globalsymtable :
-            list.concat(tai_comment.Create(strpnew('Defs - Begin unit '+st.name^+' has index '+tostr(st.moduleid))));
-        end;
-        old_writing_def_stabs:=writing_def_stabs;
-        writing_def_stabs:=true;
-        dowritestabs(list,st);
-        writing_def_stabs:=old_writing_def_stabs;
-        case st.symtabletype of
-          staticsymtable :
-            list.concat(tai_comment.Create(strpnew('Defs - End Staticsymtable')));
-          globalsymtable :
-            list.concat(tai_comment.Create(strpnew('Defs - End unit '+st.name^+' has index '+tostr(st.moduleid))));
-        end;
-      end;
-
-
-    procedure TDebugInfoStabs.write_procdef(list:taasmoutput;pd:tprocdef);
-      var
-        templist : taasmoutput;
-        stabsendlabel : tasmlabel;
-        mangled_length : longint;
-        p : pchar;
-        hs : string;
-      begin
-        if assigned(pd.procstarttai) then
-          begin
-            templist:=taasmoutput.create;
-            { para types }
-            write_def_stabstr(templist,pd);
-            if assigned(pd.parast) then
-              write_symtable_syms(templist,pd.parast);
-            { local type defs and vars should not be written
-              inside the main proc stab }
-            if assigned(pd.localst) and
-               (pd.localst.symtabletype=localsymtable) then
-              write_symtable_syms(templist,pd.localst);
-            asmlist[al_procedures].insertlistbefore(pd.procstarttai,templist);
-            { end of procedure }
-            objectlibrary.getlabel(stabsendlabel,alt_dbgtype);
-            templist.concat(tai_label.create(stabsendlabel));
-            if assigned(pd.funcretsym) and
-               (tabstractnormalvarsym(pd.funcretsym).refs>0) then
-              begin
-                if tabstractnormalvarsym(pd.funcretsym).localloc.loc=LOC_REFERENCE then
-                  begin
-    {$warning Need to add gdb support for ret in param register calling}
-                    if paramanager.ret_in_param(pd.rettype.def,pd.proccalloption) then
-                      hs:='X*'
-                    else
-                      hs:='X';
-                    templist.concat(Tai_stab.create(stab_stabs,strpnew(
-                       '"'+pd.procsym.name+':'+hs+def_stab_number(pd.rettype.def)+'",'+
-                       tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset))));
-                    if (m_result in aktmodeswitches) then
-                      templist.concat(Tai_stab.create(stab_stabs,strpnew(
-                         '"RESULT:'+hs+def_stab_number(pd.rettype.def)+'",'+
-                         tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(pd.funcretsym).localloc.reference.offset))));
-                  end;
-              end;
-            mangled_length:=length(pd.mangledname);
-            getmem(p,2*mangled_length+50);
-            strpcopy(p,'192,0,0,');
-            {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
-            strpcopy(strend(p),pd.mangledname);
-            if (target_info.use_function_relative_addresses) then
-              begin
-                strpcopy(strend(p),'-');
-                {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
-                strpcopy(strend(p),pd.mangledname);
-              end;
-            templist.concat(Tai_stab.Create(stab_stabn,strnew(p)));
-            strpcopy(p,'224,0,0,'+stabsendlabel.name);
-            if (target_info.use_function_relative_addresses) then
-              begin
-                strpcopy(strend(p),'-');
-                {$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
-                strpcopy(strend(p),pd.mangledname);
-              end;
-            templist.concat(Tai_stab.Create(stab_stabn,strnew(p)));
-            freemem(p,2*mangled_length+50);
-            asmlist[al_procedures].insertlistbefore(pd.procendtai,templist);
-            templist.free;
-          end;
-      end;
-
-
-{****************************************************************************
-                               TSym support
-****************************************************************************}
-
-    function TDebugInfoStabs.sym_var_value(const s:string;arg:pointer):string;
-      var
-        sym : tsym;
-      begin
-        sym:=tsym(arg);
-        result:='';
-        if s='name' then
-          result:=sym.name
-        else if s='mangledname' then
-          result:=sym.mangledname
-        else if s='ownername' then
-          result:=sym.owner.name^
-        else if s='line' then
-          result:=tostr(sym.fileinfo.line)
-        else if s='N_LSYM' then
-          result:=tostr(N_LSYM)
-        else if s='N_LCSYM' then
-          result:=tostr(N_LCSYM)
-        else if s='N_RSYM' then
-          result:=tostr(N_RSYM)
-        else if s='N_TSYM' then
-          result:=tostr(N_TSYM)
-        else if s='N_STSYM' then
-          result:=tostr(N_STSYM)
-        else if s='N_FUNCTION' then
-          result:=tostr(N_FUNCTION)
-        else
-          internalerror(200401152);
-      end;
-
-
-    function TDebugInfoStabs.sym_stabstr_evaluate(sym:tsym;const s:string;const vars:array of string):Pchar;
-      begin
-        result:=string_evaluate(s,@sym_var_value,sym,vars);
-      end;
-
-
-    procedure TDebugInfoStabs.insertsym(list:taasmoutput;sym:tsym);
-
-        function fieldvarsym_stabstr(sym:tfieldvarsym):Pchar;
-          begin
-            result:=nil;
-            if (sym.owner.symtabletype=objectsymtable) and
-               (sp_static in sym.symoptions) then
-              result:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}',
-                  [def_stab_number(sym.vartype.def)]);
-          end;
-
-        function globalvarsym_stabstr(sym:tglobalvarsym):Pchar;
-          var
-            st : string;
-            threadvaroffset : string;
-            regidx : Tregisterindex;
-          begin
-            result:=nil;
-            { external symbols can't be resolved at link time, so we
-              can't generate stabs for them }
-            if vo_is_external in sym.varoptions then
-              exit;
-            st:=def_stab_number(sym.vartype.def);
-            case sym.localloc.loc of
-              LOC_REGISTER,
-              LOC_CREGISTER,
-              LOC_MMREGISTER,
-              LOC_CMMREGISTER,
-              LOC_FPUREGISTER,
-              LOC_CFPUREGISTER :
-                begin
-                  regidx:=findreg_by_number(sym.localloc.register);
-                  { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
-                  { this is the register order for GDB}
-                  if regidx<>0 then
-                    result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
-                end;
-              else
-                begin
-                  if (vo_is_thread_var in sym.varoptions) then
-                    threadvaroffset:='+'+tostr(sizeof(aint))
-                  else
-                    threadvaroffset:='';
-                  { Here we used S instead of
-                    because with G GDB doesn't look at the address field
-                    but searches the same name or with a leading underscore
-                    but these names don't exist in pascal !}
-                  st:='S'+st;
-                  result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
-                end;
-            end;
-          end;
-
-        function localvarsym_stabstr(sym:tlocalvarsym):Pchar;
-          var
-            st : string;
-            regidx : Tregisterindex;
-          begin
-            result:=nil;
-            { There is no space allocated for not referenced locals }
-            if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then
-              exit;
-
-            st:=def_stab_number(sym.vartype.def);
-            case sym.localloc.loc of
-              LOC_REGISTER,
-              LOC_CREGISTER,
-              LOC_MMREGISTER,
-              LOC_CMMREGISTER,
-              LOC_FPUREGISTER,
-              LOC_CFPUREGISTER :
-                begin
-                  regidx:=findreg_by_number(sym.localloc.register);
-                  { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
-                  { this is the register order for GDB}
-                  if regidx<>0 then
-                    result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
-                end;
-              LOC_REFERENCE :
-                { offset to ebp => will not work if the framepointer is esp
-                  so some optimizing will make things harder to debug }
-                result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
-              else
-                internalerror(2003091814);
-            end;
-          end;
-
-        function paravarsym_stabstr(sym:tparavarsym):Pchar;
-          var
-            st : string;
-            regidx : Tregisterindex;
-            c : char;
-          begin
-            result:=nil;
-            { set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
-            { while stabs aren't adapted for regvars yet                             }
-            if (vo_is_self in sym.varoptions) then
-              begin
-                case sym.localloc.loc of
-                  LOC_REGISTER,
-                  LOC_CREGISTER:
-                    regidx:=findreg_by_number(sym.localloc.register);
-                  LOC_REFERENCE: ;
-                  else
-                    internalerror(2003091815);
-                end;
-                if (po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) or
-                   (po_staticmethod in tabstractprocdef(sym.owner.defowner).procoptions) then
-                  begin
-                    if (sym.localloc.loc=LOC_REFERENCE) then
-                      result:=sym_stabstr_evaluate(sym,'"pvmt:p$1",${N_TSYM},0,0,$2',
-                        [def_stab_number(pvmttype.def),tostr(sym.localloc.reference.offset)]);
-      (*            else
-                      result:=sym_stabstr_evaluate(sym,'"pvmt:r$1",${N_RSYM},0,0,$2',
-                        [def_stab_number(pvmttype.def),tostr(regstabs_table[regidx])]) *)
-                    end
-                else
-                  begin
-                    if not(is_class(tprocdef(sym.owner.defowner)._class)) then
-                      c:='v'
-                    else
-                      c:='p';
-                    if (sym.localloc.loc=LOC_REFERENCE) then
-                      result:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_TSYM},0,0,$2',
-                            [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(sym.localloc.reference.offset)]);
-      (*            else
-                      result:=sym_stabstr_evaluate(sym,'"$$t:r$1",${N_RSYM},0,0,$2',
-                            [c+def_stab_number(tprocdef(sym.owner.defowner)._class),tostr(regstabs_table[regidx])]); *)
-                  end;
-              end
-            else
-              begin
-                st:=def_stab_number(sym.vartype.def);
-
-                if paramanager.push_addr_param(sym.varspez,sym.vartype.def,tprocdef(sym.owner.defowner).proccalloption) and
-                   not(vo_has_local_copy in sym.varoptions) and
-                   not is_open_string(sym.vartype.def) then
-                  st := 'v'+st { should be 'i' but 'i' doesn't work }
-                else
-                  st := 'p'+st;
-                case sym.localloc.loc of
-                  LOC_REGISTER,
-                  LOC_CREGISTER,
-                  LOC_MMREGISTER,
-                  LOC_CMMREGISTER,
-                  LOC_FPUREGISTER,
-                  LOC_CFPUREGISTER :
-                    begin
-                      regidx:=findreg_by_number(sym.localloc.register);
-                      { "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
-                      { this is the register order for GDB}
-                      if regidx<>0 then
-                        result:=sym_stabstr_evaluate(sym,'"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(longint(regstabs_table[regidx]))]);
-                    end;
-                  LOC_REFERENCE :
-                    { offset to ebp => will not work if the framepointer is esp
-                      so some optimizing will make things harder to debug }
-                    result:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)])
-                  else
-                    internalerror(2003091814);
-                end;
-              end;
-          end;
-
-        function constsym_stabstr(sym:tconstsym):Pchar;
-          var
-            st : string;
-          begin
-            case sym.consttyp of
-              conststring:
-                begin
-                  if sym.value.len<200 then
-                    st:='s'''+backspace_quote(octal_quote(strpas(pchar(sym.value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+''''
-                  else
-                    st:='<constant string too long>';
-                end;
-              constord:
-                st:='i'+tostr(sym.value.valueord);
-              constpointer:
-                st:='i'+tostr(sym.value.valueordptr);
-              constreal:
-                begin
-                  system.str(pbestreal(sym.value.valueptr)^,st);
-                  st := 'r'+st;
-                end;
-              else
-                begin
-                  { if we don't know just put zero !! }
-                  st:='i0';
-                end;
-            end;
-            { valgrind does not support constants }
-            if cs_gdb_valgrind in aktglobalswitches then
-              result:=nil
-            else
-              result:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);
-          end;
-
-        function typesym_stabstr(sym:ttypesym) : pchar;
-          var
-            stabchar : string[2];
-          begin
-            result:=nil;
-            if not assigned(sym.restype.def) then
-              internalerror(200509262);
-            if sym.restype.def.deftype in tagtypes then
-              stabchar:='Tt'
-            else
-              stabchar:='t';
-            result:=sym_stabstr_evaluate(sym,'"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,def_stab_number(sym.restype.def)]);
-          end;
-
-        function procsym_stabstr(sym:tprocsym) : pchar;
-          var
-            i : longint;
-          begin
-            result:=nil;
-            for i:=1 to sym.procdef_count do
-              write_procdef(list,sym.procdef[i]);
-          end;
-
-      var
-        stabstr : Pchar;
-      begin
-        stabstr:=nil;
-        case sym.typ of
-          labelsym :
-            stabstr:=sym_stabstr_evaluate(sym,'"${name}",${N_LSYM},0,${line},0',[]);
-          fieldvarsym :
-            stabstr:=fieldvarsym_stabstr(tfieldvarsym(sym));
-          globalvarsym :
-            stabstr:=globalvarsym_stabstr(tglobalvarsym(sym));
-          localvarsym :
-            stabstr:=localvarsym_stabstr(tlocalvarsym(sym));
-          paravarsym :
-            stabstr:=paravarsym_stabstr(tparavarsym(sym));
-          typedconstsym :
-            stabstr:=sym_stabstr_evaluate(sym,'"${name}:S$1",${N_STSYM},0,${line},${mangledname}',
-                [def_stab_number(ttypedconstsym(sym).typedconsttype.def)]);
-          constsym :
-            stabstr:=constsym_stabstr(tconstsym(sym));
-          typesym :
-            stabstr:=typesym_stabstr(ttypesym(sym));
-          procsym :
-            stabstr:=procsym_stabstr(tprocsym(sym));
-        end;
-        if stabstr<>nil then
-          list.concat(Tai_stab.create(stab_stabs,stabstr));
-        { For object types write also the symtable entries }
-        if (sym.typ=typesym) and (ttypesym(sym).restype.def.deftype=objectdef) then
-          write_symtable_syms(list,tobjectdef(ttypesym(sym).restype.def).symtable);
-        sym.isstabwritten:=true;
-      end;
-
-
-    procedure TDebugInfoStabs.write_symtable_syms(list:taasmoutput;st:tsymtable);
-      var
-        p : tsym;
-      begin
-        case st.symtabletype of
-          staticsymtable :
-            list.concat(tai_comment.Create(strpnew('Syms - Begin Staticsymtable')));
-          globalsymtable :
-            list.concat(tai_comment.Create(strpnew('Syms - Begin unit '+st.name^+' has index '+tostr(st.moduleid))));
-        end;
-        p:=tsym(st.symindex.first);
-        while assigned(p) do
-          begin
-            if (not p.isstabwritten) then
-              insertsym(list,p);
-            p:=tsym(p.indexnext);
-          end;
-        case st.symtabletype of
-          staticsymtable :
-            list.concat(tai_comment.Create(strpnew('Syms - End Staticsymtable')));
-          globalsymtable :
-            list.concat(tai_comment.Create(strpnew('Syms - End unit '+st.name^+' has index '+tostr(st.moduleid))));
-        end;
-      end;
-
-{****************************************************************************
-                             Proc/Module support
-****************************************************************************}
-
-    procedure tdebuginfostabs.inserttypeinfo;
-
-       procedure reset_unit_type_info;
-       var
-         hp : tmodule;
-       begin
-         hp:=tmodule(loaded_units.first);
-         while assigned(hp) do
-           begin
-             hp.is_stab_written:=false;
-             hp:=tmodule(hp.next);
-           end;
-       end;
-
-       procedure write_used_unit_type_info(list:taasmoutput;hp:tmodule);
-       var
-         pu : tused_unit;
-       begin
-         pu:=tused_unit(hp.used_units.first);
-         while assigned(pu) do
-           begin
-             if not pu.u.is_stab_written then
-               begin
-                 { prevent infinte loop for circular dependencies }
-                 pu.u.is_stab_written:=true;
-                 { write type info from used units, use a depth first
-                   strategy to reduce the recursion in writing all
-                   dependent stabs }
-                 write_used_unit_type_info(list,pu.u);
-                 if assigned(pu.u.globalsymtable) then
-                   write_symtable_defs(list,pu.u.globalsymtable);
-               end;
-             pu:=tused_unit(pu.next);
-           end;
-       end;
-
-      var
-        stabsvarlist,
-        stabstypelist : taasmoutput;
-        storefilepos  : tfileposinfo;
-        st : tsymtable;
-        i  : longint;
-      begin
-        storefilepos:=aktfilepos;
-        aktfilepos:=current_module.mainfilepos;
-
-        global_stab_number:=0;
-        defnumberlist:=tlist.create;
-        stabsvarlist:=taasmoutput.create;
-        stabstypelist:=taasmoutput.create;
-
-        { include symbol that will be referenced from the main to be sure to
-          include this debuginfo .o file }
-        if current_module.is_unit then
-          begin
-            current_module.flags:=current_module.flags or uf_has_debuginfo;
-            st:=current_module.globalsymtable;
-          end
-        else
-          st:=current_module.localsymtable;
-        new_section(asmlist[al_stabs],sec_data,st.name^,0);
-        asmlist[al_stabs].concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',st,''),AT_DATA,0));
-
-        { first write all global/local symbols. This will flag all required tdefs  }
-        if assigned(current_module.globalsymtable) then
-          write_symtable_syms(stabsvarlist,current_module.globalsymtable);
-        if assigned(current_module.localsymtable) then
-          write_symtable_syms(stabsvarlist,current_module.localsymtable);
-
-        { reset unit type info flag }
-        reset_unit_type_info;
-
-        { write used types from the used units }
-        write_used_unit_type_info(stabstypelist,current_module);
-        { last write the types from this unit }
-        if assigned(current_module.globalsymtable) then
-          write_symtable_defs(stabstypelist,current_module.globalsymtable);
-        if assigned(current_module.localsymtable) then
-          write_symtable_defs(stabstypelist,current_module.localsymtable);
-
-        asmlist[al_stabs].concatlist(stabstypelist);
-        asmlist[al_stabs].concatlist(stabsvarlist);
-
-        { reset stab numbers }
-        for i:=0 to defnumberlist.count-1 do
-          begin
-            if assigned(defnumberlist[i]) then
-              begin
-                tdef(defnumberlist[i]).stab_number:=0;
-                tdef(defnumberlist[i]).stab_state:=stab_state_unused;
-              end;
-          end;
-
-        defnumberlist.free;
-        defnumberlist:=nil;
-
-        stabsvarlist.free;
-        stabstypelist.free;
-        aktfilepos:=storefilepos;
-      end;
-
-
-    procedure tdebuginfostabs.insertlineinfo(list:taasmoutput);
-      var
-        currfileinfo,
-        lastfileinfo : tfileposinfo;
-        currfuncname : pstring;
-        currsectype  : tasmsectiontype;
-        hlabel       : tasmlabel;
-        hp : tai;
-        infile : tinputfile;
-      begin
-        FillChar(lastfileinfo,sizeof(lastfileinfo),0);
-        currfuncname:=nil;
-        currsectype:=sec_code;
-        hp:=Tai(list.first);
-        while assigned(hp) do
-          begin
-            case hp.typ of
-              ait_section :
-                currsectype:=tai_section(hp).sectype;
-              ait_function_name :
-                currfuncname:=tai_function_name(hp).funcname;
-              ait_force_line :
-                lastfileinfo.line:=-1;
-            end;
-
-            if (currsectype=sec_code) and
-               (hp.typ=ait_instruction) then
-              begin
-                currfileinfo:=tailineinfo(hp).fileinfo;
-                { file changed ? (must be before line info) }
-                if (currfileinfo.fileindex<>0) and
-                   (lastfileinfo.fileindex<>currfileinfo.fileindex) then
-                  begin
-                    infile:=current_module.sourcefiles.get_file(currfileinfo.fileindex);
-                    if assigned(infile) then
-                      begin
-                        objectlibrary.getlabel(hlabel,alt_dbgfile);
-                        { emit stabs }
-                        if (infile.path^<>'') then
-                          list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_includefile)+
-                                            ',0,0,'+hlabel.name),hp);
-                        list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_includefile)+
-                                          ',0,0,'+hlabel.name),hp);
-                        list.insertbefore(tai_label.create(hlabel),hp);
-                        { force new line info }
-                        lastfileinfo.line:=-1;
-                      end;
-                  end;
-
-                { line changed ? }
-                if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then
-                  begin
-                     if assigned(currfuncname) and
-                        (target_info.use_function_relative_addresses) then
-                      begin
-                        objectlibrary.getlabel(hlabel,alt_dbgline);
-                        list.insertbefore(Tai_stab.Create_str(stab_stabn,tostr(n_textline)+',0,'+tostr(currfileinfo.line)+','+
-                                          hlabel.name+' - '+{$IFDEF POWERPC64}'.'+{$ENDIF POWERPC64}currfuncname^),hp);
-                        list.insertbefore(tai_label.create(hlabel),hp);
-                      end
-                     else
-                      list.insertbefore(Tai_stab.Create_str(stab_stabd,tostr(n_textline)+',0,'+tostr(currfileinfo.line)),hp);
-                  end;
-                lastfileinfo:=currfileinfo;
-              end;
-
-            hp:=tai(hp.next);
-          end;
-      end;
-
-
-    procedure tdebuginfostabs.insertmoduleinfo;
-      var
-        hlabel : tasmlabel;
-        infile : tinputfile;
-        templist : taasmoutput;
-      begin
-        { emit main source n_sourcefile for start of module }
-        objectlibrary.getlabel(hlabel,alt_dbgfile);
-        infile:=current_module.sourcefiles.get_file(1);
-        templist:=taasmoutput.create;
-        new_section(templist,sec_code,'',0);
-        if (infile.path^<>'') then
-          templist.concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(n_sourcefile)+
-                      ',0,0,'+hlabel.name));
-        templist.concat(Tai_stab.Create_str(stab_stabs,'"'+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+
-                    ',0,0,'+hlabel.name));
-        templist.concat(tai_label.create(hlabel));
-        asmlist[al_stabsstart].insertlist(templist);
-        templist.free;
-        { emit empty n_sourcefile for end of module }
-        objectlibrary.getlabel(hlabel,alt_dbgfile);
-        templist:=taasmoutput.create;
-        new_section(templist,sec_code,'',0);
-        templist.concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(n_sourcefile)+',0,0,'+hlabel.name));
-        templist.concat(tai_label.create(hlabel));
-        asmlist[al_stabsend].insertlist(templist);
-        templist.free;
-      end;
-
-
-    procedure tdebuginfostabs.referencesections(list:taasmoutput);
-      var
-        hp   : tused_unit;
-      begin
-        { Reference all DEBUGINFO sections from the main .text section }
-        if (target_info.system <> system_powerpc_macos) then
-          begin
-            { include reference to all debuginfo sections of used units }
-            hp:=tused_unit(usedunits.first);
-            while assigned(hp) do
-              begin
-                If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
-                  list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
-                hp:=tused_unit(hp.next);
-              end;
-            { include reference to debuginfo for this program }
-            list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
-          end;
-      end;
-
-
-    const
-      dbg_stabs_info : tdbginfo =
-         (
-           id     : dbg_stabs;
-           idtxt  : 'STABS';
-         );
-
-initialization
-  RegisterDebugInfo(dbg_stabs_info,TDebugInfoStabs);
-end.

compiler/compiler/defcmp.pas

@@ -1,1489 +0,0 @@
-{
-    Copyright (c) 1998-2002 by Florian Klaempfl
-
-    Compare definitions and parameter lists
-
-    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 defcmp;
-
-{$i fpcdefs.inc}
-
-interface
-
-    uses
-       cclasses,
-       globtype,globals,
-       node,
-       symconst,symtype,symdef;
-
-     type
-       { if acp is cp_all the var const or nothing are considered equal }
-       tcompare_paras_type = ( cp_none, cp_value_equal_const, cp_all,cp_procvar);
-       tcompare_paras_option = (cpo_allowdefaults,cpo_ignorehidden,cpo_allowconvert,cpo_comparedefaultvalue);
-       tcompare_paras_options = set of tcompare_paras_option;
-
-       tcompare_defs_option = (cdo_internal,cdo_explicit,cdo_check_operator,cdo_allow_variant);
-       tcompare_defs_options = set of tcompare_defs_option;
-
-       tconverttype = (tc_none,
-          tc_equal,
-          tc_not_possible,
-          tc_string_2_string,
-          tc_char_2_string,
-          tc_char_2_chararray,
-          tc_pchar_2_string,
-          tc_cchar_2_pchar,
-          tc_cstring_2_pchar,
-          tc_cstring_2_int,
-          tc_ansistring_2_pchar,
-          tc_string_2_chararray,
-          tc_chararray_2_string,
-          tc_array_2_pointer,
-          tc_pointer_2_array,
-          tc_int_2_int,
-          tc_int_2_bool,
-          tc_bool_2_bool,
-          tc_bool_2_int,
-          tc_real_2_real,
-          tc_int_2_real,
-          tc_real_2_currency,
-          tc_proc_2_procvar,
-          tc_arrayconstructor_2_set,
-          tc_load_smallset,
-          tc_cord_2_pointer,
-          tc_intf_2_string,
-          tc_intf_2_guid,
-          tc_class_2_intf,
-          tc_char_2_char,
-          tc_normal_2_smallset,
-          tc_dynarray_2_openarray,
-          tc_pwchar_2_string,
-          tc_variant_2_dynarray,
-          tc_dynarray_2_variant,
-          tc_variant_2_enum,
-          tc_enum_2_variant,
-          tc_interface_2_variant,
-          tc_variant_2_interface,
-          tc_array_2_dynarray
-       );
-
-    function compare_defs_ext(def_from,def_to : tdef;
-                              fromtreetype : tnodetype;
-                              var doconv : tconverttype;
-                              var operatorpd : tprocdef;
-                              cdoptions:tcompare_defs_options):tequaltype;
-
-    { Returns if the type def_from can be converted to def_to or if both types are equal }
-    function compare_defs(def_from,def_to:tdef;fromtreetype:tnodetype):tequaltype;
-
-    { Returns true, if def1 and def2 are semantically the same }
-    function equal_defs(def_from,def_to:tdef):boolean;
-
-    { Checks for type compatibility (subgroups of type)
-      used for case statements... probably missing stuff
-      to use on other types }
-    function is_subequal(def1, def2: tdef): boolean;
-
-     {# true, if two parameter lists are equal
-      if acp is cp_none, all have to match exactly
-      if acp is cp_value_equal_const call by value
-      and call by const parameter are assumed as
-      equal
-      allowdefaults indicates if default value parameters
-      are allowed (in this case, the search order will first
-      search for a routine with default parameters, before
-      searching for the same definition with no parameters)
-    }
-    function compare_paras(para1,para2 : tlist; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
-
-    { True if a function can be assigned to a procvar }
-    { changed first argument type to pabstractprocdef so that it can also be }
-    { used to test compatibility between two pprocvardefs (JM)               }
-    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
-
-
-implementation
-
-    uses
-      verbose,systems,
-      symtable,symsym,
-      defutil,symutil;
-
-
-    function compare_defs_ext(def_from,def_to : tdef;
-                              fromtreetype : tnodetype;
-                              var doconv : tconverttype;
-                              var operatorpd : tprocdef;
-                              cdoptions:tcompare_defs_options):tequaltype;
-
-      { Tbasetype:
-           uvoid,
-           u8bit,u16bit,u32bit,u64bit,
-           s8bit,s16bit,s32bit,s64bit,
-           bool8bit,bool16bit,bool32bit,
-           uchar,uwidechar }
-
-      type
-        tbasedef=(bvoid,bchar,bint,bbool);
-      const
-        basedeftbl:array[tbasetype] of tbasedef =
-          (bvoid,
-           bint,bint,bint,bint,
-           bint,bint,bint,bint,
-           bbool,bbool,bbool,
-           bchar,bchar,bint);
-
-        basedefconvertsimplicit : array[tbasedef,tbasedef] of tconverttype =
-          { void, char, int, bool }
-         ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
-          (tc_not_possible,tc_char_2_char,tc_not_possible,tc_not_possible),
-          (tc_not_possible,tc_not_possible,tc_int_2_int,tc_not_possible),
-          (tc_not_possible,tc_not_possible,tc_not_possible,tc_bool_2_bool));
-        basedefconvertsexplicit : array[tbasedef,tbasedef] of tconverttype =
-          { void, char, int, bool }
-         ((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
-          (tc_not_possible,tc_char_2_char,tc_int_2_int,tc_int_2_bool),
-          (tc_not_possible,tc_int_2_int,tc_int_2_int,tc_int_2_bool),
-          (tc_not_possible,tc_bool_2_int,tc_bool_2_int,tc_bool_2_bool));
-
-      var
-         subeq,eq : tequaltype;
-         hd1,hd2 : tdef;
-         hct : tconverttype;
-         hd3 : tobjectdef;
-         hpd : tprocdef;
-      begin
-         eq:=te_incompatible;
-         doconv:=tc_not_possible;
-
-         { safety check }
-         if not(assigned(def_from) and assigned(def_to)) then
-          begin
-            compare_defs_ext:=te_incompatible;
-            exit;
-          end;
-
-         { same def? then we've an exact match }
-         if def_from=def_to then
-          begin
-            doconv:=tc_equal;
-            compare_defs_ext:=te_exact;
-            exit;
-          end;
-
-         { we walk the wanted (def_to) types and check then the def_from
-           types if there is a conversion possible }
-         case def_to.deftype of
-           orddef :
-             begin
-               case def_from.deftype of
-                 orddef :
-                   begin
-                     if (torddef(def_from).typ=torddef(def_to).typ) then
-                      begin
-                        case torddef(def_from).typ of
-                          uchar,uwidechar,
-                          u8bit,u16bit,u32bit,u64bit,
-                          s8bit,s16bit,s32bit,s64bit:
-                            begin
-                              if (torddef(def_from).low=torddef(def_to).low) and
-                                 (torddef(def_from).high=torddef(def_to).high) then
-                                eq:=te_equal
-                              else
-                                begin
-                                  doconv:=tc_int_2_int;
-                                  eq:=te_convert_l1;
-                                end;
-                            end;
-                          uvoid,
-                          bool8bit,bool16bit,bool32bit:
-                            eq:=te_equal;
-                          else
-                            internalerror(200210061);
-                        end;
-                      end
-                     else
-                      begin
-                        if cdo_explicit in cdoptions then
-                         doconv:=basedefconvertsexplicit[basedeftbl[torddef(def_from).typ],basedeftbl[torddef(def_to).typ]]
-                        else
-                         doconv:=basedefconvertsimplicit[basedeftbl[torddef(def_from).typ],basedeftbl[torddef(def_to).typ]];
-                        if (doconv=tc_not_possible) then
-                          eq:=te_incompatible
-                        else
-                          { "punish" bad type conversions :) (JM) }
-                          if (not is_in_limit(def_from,def_to)) and
-                             (def_from.size > def_to.size) then
-                            eq:=te_convert_l3
-                        else
-                          eq:=te_convert_l1;
-                      end;
-                   end;
-                 enumdef :
-                   begin
-                     { needed for char(enum) }
-                     if cdo_explicit in cdoptions then
-                      begin
-                        doconv:=tc_int_2_int;
-                        eq:=te_convert_l1;
-                      end;
-                   end;
-                 floatdef :
-                   begin
-                     if is_currency(def_to) then
-                      begin
-                        doconv:=tc_real_2_currency;
-                        eq:=te_convert_l2;
-                      end;
-                   end;
-                 classrefdef,
-                 procvardef,
-                 pointerdef :
-                   begin
-                     if cdo_explicit in cdoptions then
-                      begin
-                        eq:=te_convert_l1;
-                        if (fromtreetype=niln) then
-                         begin
-                           { will be handled by the constant folding }
-                           doconv:=tc_equal;
-                         end
-                        else
-                         doconv:=tc_int_2_int;
-                      end;
-                   end;
-                 arraydef :
-                   begin
-                     if (m_mac in aktmodeswitches) and
-                        (fromtreetype=stringconstn) then
-                       begin
-                         eq:=te_convert_l3;
-                         doconv:=tc_cstring_2_int;
-                       end;
-                   end;
-               end;
-             end;
-
-           stringdef :
-             begin
-               case def_from.deftype of
-                 stringdef :
-                   begin
-                     { Constant string }
-                     if (fromtreetype=stringconstn) then
-                      begin
-                        { we can change the stringconst node }
-                        if (tstringdef(def_from).string_typ=st_conststring) or
-                           (tstringdef(def_from).string_typ=tstringdef(def_to).string_typ) then
-                          eq:=te_equal
-                        else
-                         begin
-                           doconv:=tc_string_2_string;
-                           { Don't prefer conversions from widestring to a
-                             normal string as we can loose information }
-                           if tstringdef(def_from).string_typ=st_widestring then
-                             eq:=te_convert_l3
-                           else if tstringdef(def_to).string_typ=st_widestring then
-                             eq:=te_convert_l2
-                           else
-                             eq:=te_equal;
-                         end;
-                      end
-                     else
-                     { Same string type, for shortstrings also the length must match }
-                      if (tstringdef(def_from).string_typ=tstringdef(def_to).string_typ) and
-                         ((tstringdef(def_from).string_typ<>st_shortstring) or
-                          (tstringdef(def_from).len=tstringdef(def_to).len)) then
-                        eq:=te_equal
-                     else
-                       begin
-                         doconv:=tc_string_2_string;
-                         case tstringdef(def_from).string_typ of
-                           st_widestring :
-                             begin
-                               { Prefer conversions to ansistring }
-                               if tstringdef(def_to).string_typ=st_ansistring then
-                                 eq:=te_convert_l2
-                               else
-                                 eq:=te_convert_l3;
-                             end;
-                           st_shortstring :
-                             begin
-                               { Prefer shortstrings of different length or conversions
-                                 from shortstring to ansistring }
-                               if (tstringdef(def_to).string_typ=st_shortstring) then
-                                 eq:=te_convert_l1
-                               else if tstringdef(def_to).string_typ=st_ansistring then
-                                 eq:=te_convert_l2
-                               else
-                                 eq:=te_convert_l3;
-                             end;
-                           st_ansistring :
-                             begin
-                               { Prefer conversion to widestrings }
-                               if (tstringdef(def_to).string_typ=st_widestring) then
-                                 eq:=te_convert_l2
-                               else
-                                 eq:=te_convert_l3;
-                             end;
-                         end;
-                       end;
-                   end;
-                 orddef :
-                   begin
-                   { char to string}
-                     if is_char(def_from) or
-                        is_widechar(def_from) then
-                      begin
-                        doconv:=tc_char_2_string;
-                        eq:=te_convert_l1;
-                      end;
-                   end;
-                 arraydef :
-                   begin
-                     { array of char to string, the length check is done by the firstpass of this node }
-                     if is_chararray(def_from) or is_open_chararray(def_from) then
-                      begin
-                        { "Untyped" stringconstn is an array of char }
-                        if fromtreetype=stringconstn then
-                          begin
-                            doconv:=tc_string_2_string;
-                            { prefered string type depends on the $H switch }
-                            if not(cs_ansistrings in aktlocalswitches) and
-                               (tstringdef(def_to).string_typ=st_shortstring) then
-                              eq:=te_equal
-                            else if (cs_ansistrings in aktlocalswitches) and
-                               (tstringdef(def_to).string_typ=st_ansistring) then
-                              eq:=te_equal
-                            else if tstringdef(def_to).string_typ=st_widestring then
-                              eq:=te_convert_l3
-                            else
-                              eq:=te_convert_l1;
-                          end
-                        else
-                          begin
-                          doconv:=tc_chararray_2_string;
-                          if is_open_array(def_from) then
-                            begin
-                              if is_ansistring(def_to) then
-                                eq:=te_convert_l1
-                              else if is_widestring(def_to) then
-                                eq:=te_convert_l3
-                              else
-                                eq:=te_convert_l2;
-                            end
-                          else
-                            begin
-                              if is_shortstring(def_to) then
-                                begin
-                                  { Only compatible with arrays that fit
-                                    smaller than 255 chars }
-                                  if (def_from.size <= 255) then
-                                    eq:=te_convert_l1;
-                                end
-                              else if is_ansistring(def_to) then
-                                begin
-                                  if (def_from.size > 255) then
-                                    eq:=te_convert_l1
-                                  else
-                                    eq:=te_convert_l2;
-                                end
-                              else if is_widestring(def_to) then
-                                eq:=te_convert_l3
-                              else
-                                eq:=te_convert_l2;
-                            end;
-                          end;
-                      end
-                     else
-                     { array of widechar to string, the length check is done by the firstpass of this node }
-                      if is_widechararray(def_from) or is_open_widechararray(def_from) then
-                       begin
-                         doconv:=tc_chararray_2_string;
-                         if is_widestring(def_to) then
-                           eq:=te_convert_l1
-                         else
-                           { size of widechar array is double due the sizeof a widechar }
-                           if not(is_shortstring(def_to) and (def_from.size>255*sizeof(widechar))) then
-                             eq:=te_convert_l3
-                         else
-                           eq:=te_convert_l2;
-                       end;
-                   end;
-                 pointerdef :
-                   begin
-                   { pchar can be assigned to short/ansistrings,
-                     but not in tp7 compatible mode }
-                     if not(m_tp7 in aktmodeswitches) then
-                       begin
-                          if is_pchar(def_from) then
-                           begin
-                             doconv:=tc_pchar_2_string;
-                             { prefer ansistrings because pchars can overflow shortstrings, }
-                             { but only if ansistrings are the default (JM)                 }
-                             if (is_shortstring(def_to) and
-                                 not(cs_ansistrings in aktlocalswitches)) or
-                                (is_ansistring(def_to) and
-                                 (cs_ansistrings in aktlocalswitches)) then
-                               eq:=te_convert_l1
-                             else
-                               eq:=te_convert_l2;
-                           end
-                          else if is_pwidechar(def_from) then
-                           begin
-                             doconv:=tc_pwchar_2_string;
-                             if is_widestring(def_to) then
-                               eq:=te_convert_l1
-                             else
-                               eq:=te_convert_l3;
-                           end;
-                       end;
-                   end;
-               end;
-             end;
-
-           floatdef :
-             begin
-               case def_from.deftype of
-                 orddef :
-                   begin { ordinal to real }
-                     if is_integer(def_from) or
-                        (is_currency(def_from) and
-                         (s64currencytype.def.deftype = floatdef)) then
-                       begin
-                         doconv:=tc_int_2_real;
-                         eq:=te_convert_l1;
-                       end
-                     else if is_currency(def_from)
-                             { and (s64currencytype.def.deftype = orddef)) } then
-                       begin
-                         { prefer conversion to orddef in this case, unless    }
-                         { the orddef < currency (then it will get convert l3, }
-                         { and conversion to float is favoured)                }
-                         doconv:=tc_int_2_real;
-                         eq:=te_convert_l2;
-                       end;
-                   end;
-                 floatdef :
-                   begin
-                     if tfloatdef(def_from).typ=tfloatdef(def_to).typ then
-                       eq:=te_equal
-                     else
-                       begin
-                         if (fromtreetype=realconstn) or
-                            not((cdo_explicit in cdoptions) and
-                                (m_delphi in aktmodeswitches)) then
-                           begin
-                             doconv:=tc_real_2_real;
-                             { do we loose precision? }
-                             if def_to.size<def_from.size then
-                               eq:=te_convert_l2
-                             else
-                               eq:=te_convert_l1;
-                           end;
-                       end;
-                   end;
-               end;
-             end;
-
-           enumdef :
-             begin
-               case def_from.deftype of
-                 enumdef :
-                   begin
-                     if cdo_explicit in cdoptions then
-                      begin
-                        eq:=te_convert_l1;
-                        doconv:=tc_int_2_int;
-                      end
-                     else
-                      begin
-                        hd1:=def_from;
-                        while assigned(tenumdef(hd1).basedef) do
-                          hd1:=tenumdef(hd1).basedef;
-                        hd2:=def_to;
-                        while assigned(tenumdef(hd2).basedef) do
-                          hd2:=tenumdef(hd2).basedef;
-                        if (hd1=hd2) then
-                          begin
-                            eq:=te_convert_l1;
-                            { because of packenum they can have different sizes! (JM) }
-                            doconv:=tc_int_2_int;
-                          end
-                        else
-                          begin
-                            { assignment of an enum symbol to an unique type? }
-                            if (fromtreetype=ordconstn) and
-                              (tenumsym(tenumdef(hd1).firstenum)=tenumsym(tenumdef(hd2).firstenum)) then
-                              begin
-                                { because of packenum they can have different sizes! (JM) }
-                                eq:=te_convert_l1;
-                                doconv:=tc_int_2_int;
-                              end;
-                          end;
-                      end;
-                   end;
-                 orddef :
-                   begin
-                     if cdo_explicit in cdoptions then
-                      begin
-                        eq:=te_convert_l1;
-                        doconv:=tc_int_2_int;
-                      end;
-                   end;
-                 variantdef :
-                   begin
-                     eq:=te_convert_l1;
-                     doconv:=tc_variant_2_enum;
-                   end;
-                 pointerdef :
-                   begin
-                     { ugly, but delphi allows it }
-                     if (cdo_explicit in cdoptions) and
-                       (m_delphi in aktmodeswitches) and
-                       (eq=te_incompatible) then
-                       begin
-                         doconv:=tc_int_2_int;
-                         eq:=te_convert_l1;
-                       end;
-                   end;
-               end;
-             end;
-
-           arraydef :
-             begin
-             { open array is also compatible with a single element of its base type }
-               if is_open_array(def_to) and
-                  equal_defs(def_from,tarraydef(def_to).elementtype.def) then
-                begin
-                  doconv:=tc_equal;
-                  eq:=te_convert_l1;
-                end
-               else
-                begin
-                  case def_from.deftype of
-                    arraydef :
-                      begin
-                        { to dynamic array }
-                        if is_dynamic_array(def_to) then
-                         begin
-                           if equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
-                             begin
-                               { dynamic array -> dynamic array }
-                               if is_dynamic_array(def_from) then
-                                 eq:=te_equal
-                               { fpc modes only: array -> dyn. array }
-                               else if (aktmodeswitches*[m_objfpc,m_fpc]<>[]) and
-                                 not(is_special_array(def_from)) and
-                                 is_zero_based_array(def_from) then
-                                 begin
-                                   eq:=te_convert_l2;
-                                   doconv:=tc_array_2_dynarray;
-                                 end;
-                             end
-                         end
-                        else
-                         { to open array }
-                         if is_open_array(def_to) then
-                          begin
-                            { array constructor -> open array }
-                            if is_array_constructor(def_from) then
-                             begin
-                               if is_void(tarraydef(def_from).elementtype.def) then
-                                begin
-                                  doconv:=tc_equal;
-                                  eq:=te_convert_l1;
-                                end
-                               else
-                                begin
-                                  subeq:=compare_defs_ext(tarraydef(def_from).elementtype.def,
-                                                       tarraydef(def_to).elementtype.def,
-                                                       arrayconstructorn,hct,hpd,[cdo_check_operator]);
-                                  if (subeq>=te_equal) then
-                                    begin
-                                      doconv:=tc_equal;
-                                      eq:=te_convert_l1;
-                                    end
-                                  else
-                                   if (subeq>te_incompatible) then
-                                    begin
-                                      doconv:=hct;
-                                      eq:=te_convert_l2;
-                                    end;
-                                end;
-                             end
-                            else
-                             { dynamic array -> open array }
-                             if is_dynamic_array(def_from) and
-                                equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
-                               begin
-                                 doconv:=tc_dynarray_2_openarray;
-                                 eq:=te_convert_l2;
-                               end
-                            else
-                             { array -> open array }
-                             if equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
-                               eq:=te_equal;
-                          end
-                        else
-                         { to array of const }
-                         if is_array_of_const(def_to) then
-                          begin
-                            if is_array_of_const(def_from) or
-                               is_array_constructor(def_from) then
-                             begin
-                               eq:=te_equal;
-                             end
-                            else
-                             { array of tvarrec -> array of const }
-                             if equal_defs(tarraydef(def_to).elementtype.def,tarraydef(def_from).elementtype.def) then
-                              begin
-                                doconv:=tc_equal;
-                                eq:=te_convert_l1;
-                              end;
-                          end
-                        else
-                          { to array of char, from "Untyped" stringconstn (array of char) }
-                          if (fromtreetype=stringconstn) and
-                             (is_chararray(def_to) or
-                              is_widechararray(def_to)) then
-                            begin
-                              eq:=te_convert_l1;
-                              doconv:=tc_string_2_chararray;
-                            end
-                        else
-                         { other arrays }
-                          begin
-                            { open array -> array }
-                            if is_open_array(def_from) and
-                               equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) then
-                              begin
-                                eq:=te_equal
-                              end
-                            else
-                            { array -> array }
-                             if not(m_tp7 in aktmodeswitches) and
-                                not(m_delphi in aktmodeswitches) and
-                                (tarraydef(def_from).lowrange=tarraydef(def_to).lowrange) and
-                                (tarraydef(def_from).highrange=tarraydef(def_to).highrange) and
-                                equal_defs(tarraydef(def_from).elementtype.def,tarraydef(def_to).elementtype.def) and
-                                equal_defs(tarraydef(def_from).rangetype.def,tarraydef(def_to).rangetype.def) then
-                              begin
-                                eq:=te_equal
-                              end;
-                          end;
-                      end;
-                    pointerdef :
-                      begin
-                        { nil and voidpointers are compatible with dyn. arrays }
-                        if is_dynamic_array(def_to) and
-                           ((fromtreetype=niln) or
-                            is_voidpointer(def_from)) then
-                         begin
-                           doconv:=tc_equal;
-                           eq:=te_convert_l1;
-                         end
-                        else
-                         if is_zero_based_array(def_to) and
-                            equal_defs(tpointerdef(def_from).pointertype.def,tarraydef(def_to).elementtype.def) then
-                          begin
-                            doconv:=tc_pointer_2_array;
-                            eq:=te_convert_l1;
-                          end;
-                      end;
-                    stringdef :
-                      begin
-                        { string to char array }
-                        if (not is_special_array(def_to)) and
-                           (is_char(tarraydef(def_to).elementtype.def)or
-                            is_widechar(tarraydef(def_to).elementtype.def)) then
-                         begin
-                           doconv:=tc_string_2_chararray;
-                           eq:=te_convert_l1;
-                         end;
-                      end;
-                    orddef:
-                      begin
-                        if is_chararray(def_to) and
-                           is_char(def_from) then
-                          begin
-                            doconv:=tc_char_2_chararray;
-                            eq:=te_convert_l2;
-                          end;
-                      end;
-                    recorddef :
-                      begin
-                        { tvarrec -> array of const }
-                         if is_array_of_const(def_to) and
-                            equal_defs(def_from,tarraydef(def_to).elementtype.def) then
-                          begin
-                            doconv:=tc_equal;
-                            eq:=te_convert_l1;
-                          end;
-                      end;
-                    variantdef :
-                      begin
-                         if is_dynamic_array(def_to) then
-                           begin
-                              doconv:=tc_variant_2_dynarray;
-                              eq:=te_convert_l1;
-                           end;
-                      end;
-                  end;
-                end;
-             end;
-
-           variantdef :
-             begin
-               if (cdo_allow_variant in cdoptions) then
-                 begin
-                   case def_from.deftype of
-                     enumdef :
-                       begin
-                         doconv:=tc_enum_2_variant;
-                         eq:=te_convert_l1;
-                       end;
-                     arraydef :
-                       begin
-                          if is_dynamic_array(def_from) then
-                            begin
-                               doconv:=tc_dynarray_2_variant;
-                               eq:=te_convert_l1;
-                            end;
-                       end;
-                     objectdef :
-                       begin
-                          if is_interface(def_from) then
-                            begin
-                               doconv:=tc_interface_2_variant;
-                               eq:=te_convert_l1;
-                            end;
-                       end;
-                   end;
-                 end;
-             end;
-
-           pointerdef :
-             begin
-               case def_from.deftype of
-                 stringdef :
-                   begin
-                     { string constant (which can be part of array constructor)
-                       to zero terminated string constant }
-                     if (fromtreetype in [arrayconstructorn,stringconstn]) and
-                        (is_pchar(def_to) or is_pwidechar(def_to)) then
-                      begin
-                        doconv:=tc_cstring_2_pchar;
-                        eq:=te_convert_l2;
-                      end
-                     else
-                      if cdo_explicit in cdoptions then
-                       begin
-                         { pchar(ansistring) }
-                         if is_pchar(def_to) and
-                            is_ansistring(def_from) then
-                          begin
-                            doconv:=tc_ansistring_2_pchar;
-                            eq:=te_convert_l1;
-                          end
-                         else
-                          { pwidechar(widestring) }
-                          if is_pwidechar(def_to) and
-                             is_widestring(def_from) then
-                           begin
-                             doconv:=tc_ansistring_2_pchar;
-                             eq:=te_convert_l1;
-                           end;
-                       end;
-                   end;
-                 orddef :
-                   begin
-                     { char constant to zero terminated string constant }
-                     if (fromtreetype=ordconstn) then
-                      begin
-                        if (is_char(def_from) or is_widechar(def_from)) and
-                           (is_pchar(def_to) or is_pwidechar(def_to)) then
-                         begin
-                           doconv:=tc_cchar_2_pchar;
-                           eq:=te_convert_l1;
-                         end
-                        else
-                         if (m_delphi in aktmodeswitches) and is_integer(def_from) then
-                          begin
-                            doconv:=tc_cord_2_pointer;
-                            eq:=te_convert_l2;
-                          end;
-                      end;
-                     { delphi compatible, allow explicit typecasts from
-                       ordinals to pointer.
-                       It is also used by the compiler internally for inc(pointer,ordinal) }
-                     if (eq=te_incompatible) and
-                        not is_void(def_from) and
-                        (
-                         (
-                          (m_delphi in aktmodeswitches) and
-                          (cdo_explicit in cdoptions)
-                         ) or
-                         (cdo_internal in cdoptions)
-                        ) then
-                      begin
-                        doconv:=tc_int_2_int;
-                        eq:=te_convert_l1;
-                      end;
-                   end;
-                 arraydef :
-                   begin
-                     { string constant (which can be part of array constructor)
-                       to zero terminated string constant }
-                     if (fromtreetype in [arrayconstructorn,stringconstn]) and
-                        (is_pchar(def_to) or is_pwidechar(def_to)) then
-                      begin
-                        doconv:=tc_cstring_2_pchar;
-                        eq:=te_convert_l2;
-                      end
-                     else
-                      { chararray to pointer }
-                      if (is_zero_based_array(def_from) or
-                          is_open_array(def_from)) and
-                          equal_defs(tarraydef(def_from).elementtype.def,tpointerdef(def_to).pointertype.def) then
-                        begin
-                          doconv:=tc_array_2_pointer;
-                          { don't prefer the pchar overload when a constant
-                            string was passed }
-                          if fromtreetype=stringconstn then
-                            eq:=te_convert_l2
-                          else
-                            eq:=te_convert_l1;
-                        end
-                     else
-                       { dynamic array to pointer, delphi only }
-                       if (m_delphi in aktmodeswitches) and
-                          is_dynamic_array(def_from) then
-                        begin
-                          eq:=te_equal;
-                        end;
-                   end;
-                 pointerdef :
-                   begin
-                     { check for far pointers }
-                     if (tpointerdef(def_from).is_far<>tpointerdef(def_to).is_far) then
-                       begin
-                         eq:=te_incompatible;
-                       end
-                     else
-                      { the types can be forward type, handle before normal type check !! }
-                      if assigned(def_to.typesym) and
-                         (tpointerdef(def_to).pointertype.def.deftype=forwarddef) then
-                       begin
-                         if (def_from.typesym=def_to.typesym) then
-                          eq:=te_equal
-                       end
-                     else
-                      { same types }
-                      if equal_defs(tpointerdef(def_from).pointertype.def,tpointerdef(def_to).pointertype.def) then
-                       begin
-                         eq:=te_equal
-                       end
-                     else
-                      { child class pointer can be assigned to anchestor pointers }
-                      if (
-                          (tpointerdef(def_from).pointertype.def.deftype=objectdef) and
-                          (tpointerdef(def_to).pointertype.def.deftype=objectdef) and
-                          tobjectdef(tpointerdef(def_from).pointertype.def).is_related(
-                            tobjectdef(tpointerdef(def_to).pointertype.def))
-                         ) then
-                       begin
-                         doconv:=tc_equal;
-                         eq:=te_convert_l1;
-                       end
-                     else
-                      { all pointers can be assigned to void-pointer }
-                      if is_void(tpointerdef(def_to).pointertype.def) then
-                       begin
-                         doconv:=tc_equal;
-                         { give pwidechar,pchar a penalty so it prefers
-                           conversion to ansistring }
-                         if is_pchar(def_from) or
-                            is_pwidechar(def_from) then
-                           eq:=te_convert_l2
-                         else
-                           eq:=te_convert_l1;
-                       end
-                     else
-                      { all pointers can be assigned from void-pointer }
-                      if is_void(tpointerdef(def_from).pointertype.def) or
-                      { all pointers can be assigned from void-pointer or formaldef pointer, check
-                        tw3777.pp if you change this }
-                        (tpointerdef(def_from).pointertype.def.deftype=formaldef) then
-                       begin
-                         doconv:=tc_equal;
-                         { give pwidechar a penalty so it prefers
-                           conversion to pchar }
-                         if is_pwidechar(def_to) then
-                           eq:=te_convert_l2
-                         else
-                           eq:=te_convert_l1;
-                       end;
-                   end;
-                 procvardef :
-                   begin
-                     { procedure variable can be assigned to an void pointer,
-                       this not allowed for methodpointers }
-                     if (is_void(tpointerdef(def_to).pointertype.def) or
-                         (m_mac_procvar in aktmodeswitches)) and
-                        tprocvardef(def_from).is_addressonly then
-                      begin
-                        doconv:=tc_equal;
-                        eq:=te_convert_l1;
-                      end;
-                   end;
-                 procdef :
-                   begin
-                     { procedure variable can be assigned to an void pointer,
-                       this not allowed for methodpointers }
-                     if (m_mac_procvar in aktmodeswitches) and
-                        tprocdef(def_from).is_addressonly then
-                      begin
-                        doconv:=tc_proc_2_procvar;
-                        eq:=te_convert_l2;
-                      end;
-                   end;
-                 classrefdef,
-                 objectdef :
-                   begin
-                     { class types and class reference type
-                       can be assigned to void pointers, but it is less
-                       preferred than assigning to a related objectdef }
-                     if (
-                         is_class_or_interface(def_from) or
-                         (def_from.deftype=classrefdef)
-                        ) and
-                        (tpointerdef(def_to).pointertype.def.deftype=orddef) and
-                        (torddef(tpointerdef(def_to).pointertype.def).typ=uvoid) then
-                       begin
-                         doconv:=tc_equal;
-                         eq:=te_convert_l2;
-                       end;
-                   end;
-               end;
-             end;
-
-           setdef :
-             begin
-               case def_from.deftype of
-                 setdef :
-                   begin
-                     if assigned(tsetdef(def_from).elementtype.def) and
-                        assigned(tsetdef(def_to).elementtype.def) then
-                      begin
-                        { sets with the same element base type are equal }
-                        if is_subequal(tsetdef(def_from).elementtype.def,tsetdef(def_to).elementtype.def) then
-                         eq:=te_equal;
-                      end
-                     else
-                      { empty set is compatible with everything }
-                      eq:=te_equal;
-                   end;
-                 arraydef :
-                   begin
-                     { automatic arrayconstructor -> set conversion }
-                     if is_array_constructor(def_from) then
-                      begin
-                        doconv:=tc_arrayconstructor_2_set;
-                        eq:=te_convert_l1;
-                      end;
-                   end;
-               end;
-             end;
-
-           procvardef :
-             begin
-               case def_from.deftype of
-                 procdef :
-                   begin
-                     { proc -> procvar }
-                     if (m_tp_procvar in aktmodeswitches) or
-                        (m_mac_procvar in aktmodeswitches) then
-                      begin
-                        subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to));
-                        if subeq>te_incompatible then
-                         begin
-                           doconv:=tc_proc_2_procvar;
-                           eq:=te_convert_l1;
-                         end;
-                      end;
-                   end;
-                 procvardef :
-                   begin
-                     { procvar -> procvar }
-                     eq:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to));
-                   end;
-                 pointerdef :
-                   begin
-                     { nil is compatible with procvars }
-                     if (fromtreetype=niln) then
-                      begin
-                        doconv:=tc_equal;
-                        eq:=te_convert_l1;
-                      end
-                     else
-                      { for example delphi allows the assignement from pointers }
-                      { to procedure variables                                  }
-                      if (m_pointer_2_procedure in aktmodeswitches) and
-                         is_void(tpointerdef(def_from).pointertype.def) and
-                         tprocvardef(def_to).is_addressonly then
-                       begin
-                         doconv:=tc_equal;
-                         eq:=te_convert_l1;
-                       end;
-                   end;
-               end;
-             end;
-
-           objectdef :
-             begin
-               { object pascal objects }
-               if (def_from.deftype=objectdef) and
-                  (tobjectdef(def_from).is_related(tobjectdef(def_to))) then
-                begin
-                  doconv:=tc_equal;
-                  eq:=te_convert_l1;
-                end
-               else
-               { Class/interface specific }
-                if is_class_or_interface(def_to) then
-                 begin
-                   { void pointer also for delphi mode }
-                   if (m_delphi in aktmodeswitches) and
-                      is_voidpointer(def_from) then
-                    begin
-                      doconv:=tc_equal;
-                      { prefer pointer-pointer assignments }
-                      eq:=te_convert_l2;
-                    end
-                   else
-                   { nil is compatible with class instances and interfaces }
-                    if (fromtreetype=niln) then
-                     begin
-                       doconv:=tc_equal;
-                       eq:=te_convert_l1;
-                     end
-                   { classes can be assigned to interfaces }
-                   else if is_interface(def_to) and
-                     is_class(def_from) and
-                     assigned(tobjectdef(def_from).implementedinterfaces) then
-                     begin
-                        { we've to search in parent classes as well }
-                        hd3:=tobjectdef(def_from);
-                        while assigned(hd3) do
-                          begin
-                             if hd3.implementedinterfaces.searchintf(def_to)<>-1 then
-                               begin
-                                  doconv:=tc_class_2_intf;
-                                  { don't prefer this over objectdef->objectdef }
-                                  eq:=te_convert_l2;
-                                  break;
-                               end;
-                             hd3:=hd3.childof;
-                          end;
-                     end
-                   { Interface 2 GUID handling }
-                   else if (def_to=tdef(rec_tguid)) and
-                           (fromtreetype=typen) and
-                           is_interface(def_from) and
-                           assigned(tobjectdef(def_from).iidguid) then
-                     begin
-                       eq:=te_convert_l1;
-                       doconv:=tc_equal;
-                     end
-                   else if (def_from.deftype=variantdef) and is_interface(def_to) then
-                     begin
-                       doconv:=tc_variant_2_interface;
-                       eq:=te_convert_l2;
-                     end
-                   { ugly, but delphi allows it }
-                   else if (eq=te_incompatible) and
-                     (def_from.deftype=orddef) and
-                     (m_delphi in aktmodeswitches) and
-                     (cdo_explicit in cdoptions) then
-                     begin
-                       doconv:=tc_int_2_int;
-                       eq:=te_convert_l1;
-                     end;
-                 end;
-             end;
-
-           classrefdef :
-             begin
-               { similar to pointerdef wrt forwards }
-               if assigned(def_to.typesym) and
-                  (tclassrefdef(def_to).pointertype.def.deftype=forwarddef) then
-                 begin
-                   if (def_from.typesym=def_to.typesym) then
-                    eq:=te_equal;
-                 end
-               else
-                { class reference types }
-                if (def_from.deftype=classrefdef) then
-                 begin
-                   if equal_defs(tclassrefdef(def_from).pointertype.def,tclassrefdef(def_to).pointertype.def) then
-                    begin
-                      eq:=te_equal;
-                    end
-                   else
-                    begin
-                      doconv:=tc_equal;
-                      if (cdo_explicit in cdoptions) or
-                         tobjectdef(tclassrefdef(def_from).pointertype.def).is_related(
-                           tobjectdef(tclassrefdef(def_to).pointertype.def)) then
-                        eq:=te_convert_l1;
-                    end;
-                 end
-               else
-                { nil is compatible with class references }
-                if (fromtreetype=niln) then
-                 begin
-                   doconv:=tc_equal;
-                   eq:=te_convert_l1;
-                 end;
-             end;
-
-           filedef :
-             begin
-               { typed files are all equal to the abstract file type
-               name TYPEDFILE in system.pp in is_equal in types.pas
-               the problem is that it sholud be also compatible to FILE
-               but this would leed to a problem for ASSIGN RESET and REWRITE
-               when trying to find the good overloaded function !!
-               so all file function are doubled in system.pp
-               this is not very beautiful !!}
-               if (def_from.deftype=filedef) then
-                begin
-                  if (tfiledef(def_from).filetyp=tfiledef(def_to).filetyp) then
-                   begin
-                     if
-                        (
-                         (tfiledef(def_from).typedfiletype.def=nil) and
-                         (tfiledef(def_to).typedfiletype.def=nil)
-                        ) or
-                        (
-                         (tfiledef(def_from).typedfiletype.def<>nil) and
-                         (tfiledef(def_to).typedfiletype.def<>nil) and
-                         equal_defs(tfiledef(def_from).typedfiletype.def,tfiledef(def_to).typedfiletype.def)
-                        ) or
-                        (
-                         (tfiledef(def_from).filetyp = ft_typed) and
-                         (tfiledef(def_to).filetyp = ft_typed) and
-                         (
-                          (tfiledef(def_from).typedfiletype.def = tdef(voidtype.def)) or
-                          (tfiledef(def_to).typedfiletype.def = tdef(voidtype.def))
-                         )
-                        ) then
-                      begin
-                        eq:=te_equal;
-                      end;
-                   end
-                  else
-                   if ((tfiledef(def_from).filetyp = ft_untyped) and
-                       (tfiledef(def_to).filetyp = ft_typed)) or
-                      ((tfiledef(def_from).filetyp = ft_typed) and
-                       (tfiledef(def_to).filetyp = ft_untyped)) then
-                    begin
-                      doconv:=tc_equal;
-                      eq:=te_convert_l1;
-                    end;
-                end;
-             end;
-
-           recorddef :
-             begin
-               { interface -> guid }
-               if is_interface(def_from) and
-                  (def_to=rec_tguid) then
-                begin
-                  doconv:=tc_intf_2_guid;
-                  eq:=te_convert_l1;
-                end;
-             end;
-
-           formaldef :
-             begin
-               doconv:=tc_equal;
-               if (def_from.deftype=formaldef) then
-                 eq:=te_equal
-               else
-                { Just about everything can be converted to a formaldef...}
-                if not (def_from.deftype in [abstractdef,errordef]) then
-                  eq:=te_convert_l1;
-             end;
-        end;
-
-        { if we didn't find an appropriate type conversion yet
-          then we search also the := operator }
-        if (eq=te_incompatible) and
-           (
-            { Check for variants? }
-            (
-             (cdo_allow_variant in cdoptions) and
-             ((def_from.deftype=variantdef) or (def_to.deftype=variantdef))
-            ) or
-            { Check for operators? }
-            (
-             (cdo_check_operator in cdoptions) and
-             ((def_from.deftype in [objectdef,recorddef,arraydef,stringdef,variantdef]) or
-              (def_to.deftype in [objectdef,recorddef,arraydef,stringdef,variantdef]))
-            )
-           ) then
-          begin
-            operatorpd:=search_assignment_operator(def_from,def_to);
-            if assigned(operatorpd) then
-             eq:=te_convert_operator;
-          end;
-
-        { update convtype for te_equal when it is not yet set }
-        if (eq=te_equal) and
-           (doconv=tc_not_possible) then
-          doconv:=tc_equal;
-
-        compare_defs_ext:=eq;
-      end;
-
-
-    function equal_defs(def_from,def_to:tdef):boolean;
-      var
-        convtyp : tconverttype;
-        pd : tprocdef;
-      begin
-        { Compare defs with nothingn and no explicit typecasts and
-          searching for overloaded operators is not needed }
-        equal_defs:=(compare_defs_ext(def_from,def_to,nothingn,convtyp,pd,[])>=te_equal);
-      end;
-
-
-    function compare_defs(def_from,def_to:tdef;fromtreetype:tnodetype):tequaltype;
-      var
-        doconv : tconverttype;
-        pd : tprocdef;
-      begin
-        compare_defs:=compare_defs_ext(def_from,def_to,fromtreetype,doconv,pd,[cdo_check_operator,cdo_allow_variant]);
-      end;
-
-
-    function is_subequal(def1, def2: tdef): boolean;
-      var
-         basedef1,basedef2 : tenumdef;
-
-      Begin
-        is_subequal := false;
-        if assigned(def1) and assigned(def2) then
-         Begin
-           if (def1.deftype = orddef) and (def2.deftype = orddef) then
-            Begin
-              { see p.47 of Turbo Pascal 7.01 manual for the separation of types }
-              { range checking for case statements is done with testrange        }
-              case torddef(def1).typ of
-                u8bit,u16bit,u32bit,u64bit,
-                s8bit,s16bit,s32bit,s64bit :
-                  is_subequal:=(torddef(def2).typ in [s64bit,u64bit,s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]);
-                bool8bit,bool16bit,bool32bit :
-                  is_subequal:=(torddef(def2).typ in [bool8bit,bool16bit,bool32bit]);
-                uchar :
-                  is_subequal:=(torddef(def2).typ=uchar);
-                uwidechar :
-                  is_subequal:=(torddef(def2).typ=uwidechar);
-              end;
-            end
-           else
-            Begin
-              { Check if both basedefs are equal }
-              if (def1.deftype=enumdef) and (def2.deftype=enumdef) then
-                Begin
-                   { get both basedefs }
-                   basedef1:=tenumdef(def1);
-                   while assigned(basedef1.basedef) do
-                     basedef1:=basedef1.basedef;
-                   basedef2:=tenumdef(def2);
-                   while assigned(basedef2.basedef) do
-                     basedef2:=basedef2.basedef;
-                   is_subequal:=(basedef1=basedef2);
-                end;
-            end;
-         end;
-      end;
-
-
-    function compare_paras(para1,para2 : tlist; acp : tcompare_paras_type; cpoptions: tcompare_paras_options):tequaltype;
-      var
-        currpara1,
-        currpara2 : tparavarsym;
-        eq,lowesteq : tequaltype;
-        hpd       : tprocdef;
-        convtype  : tconverttype;
-        cdoptions : tcompare_defs_options;
-        i1,i2     : byte;
-      begin
-         compare_paras:=te_incompatible;
-         cdoptions:=[cdo_check_operator,cdo_allow_variant];
-         { we need to parse the list from left-right so the
-           not-default parameters are checked first }
-         lowesteq:=high(tequaltype);
-         i1:=0;
-         i2:=0;
-         if cpo_ignorehidden in cpoptions then
-           begin
-             while (i1<para1.count) and
-                   (vo_is_hidden_para in tparavarsym(para1[i1]).varoptions) do
-               inc(i1);
-             while (i2<para2.count) and
-                   (vo_is_hidden_para in tparavarsym(para2[i2]).varoptions) do
-               inc(i2);
-           end;
-         while (i1<para1.count) and (i2<para2.count) do
-           begin
-             eq:=te_incompatible;
-
-             currpara1:=tparavarsym(para1[i1]);
-             currpara2:=tparavarsym(para2[i2]);
-
-             { Unique types must match exact }
-             if ((df_unique in currpara1.vartype.def.defoptions) or (df_unique in currpara2.vartype.def.defoptions)) and
-                (currpara1.vartype.def<>currpara2.vartype.def) then
-               exit;
-
-             { Handle hidden parameters separately, because self is
-               defined as voidpointer for methodpointers }
-             if (vo_is_hidden_para in currpara1.varoptions) or
-                (vo_is_hidden_para in currpara2.varoptions) then
-              begin
-                { both must be hidden }
-                if (vo_is_hidden_para in currpara1.varoptions)<>(vo_is_hidden_para in currpara2.varoptions) then
-                  exit;
-                eq:=te_equal;
-                if not(vo_is_self in currpara1.varoptions) and
-                   not(vo_is_self in currpara2.varoptions) then
-                 begin
-                   if (currpara1.varspez<>currpara2.varspez) then
-                    exit;
-                   eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
-                                        convtype,hpd,cdoptions);
-                 end;
-              end
-             else
-              begin
-                case acp of
-                  cp_value_equal_const :
-                    begin
-                       if (
-                           (currpara1.varspez<>currpara2.varspez) and
-                           ((currpara1.varspez in [vs_var,vs_out]) or
-                            (currpara2.varspez in [vs_var,vs_out]))
-                          ) then
-                         exit;
-                       eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
-                                            convtype,hpd,cdoptions);
-                    end;
-                  cp_all :
-                    begin
-                       if (currpara1.varspez<>currpara2.varspez) then
-                         exit;
-                       eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
-                                            convtype,hpd,cdoptions);
-                    end;
-                  cp_procvar :
-                    begin
-                       if (currpara1.varspez<>currpara2.varspez) then
-                         exit;
-                       eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
-                                            convtype,hpd,cdoptions);
-                       { Parameters must be at least equal otherwise the are incompatible }
-                       if (eq<te_equal) then
-                         eq:=te_incompatible;
-                    end;
-                  else
-                    eq:=compare_defs_ext(currpara1.vartype.def,currpara2.vartype.def,nothingn,
-                                         convtype,hpd,cdoptions);
-                 end;
-               end;
-              { check type }
-              if eq=te_incompatible then
-                exit;
-              if eq<lowesteq then
-                lowesteq:=eq;
-              { also check default value if both have it declared }
-              if (cpo_comparedefaultvalue in cpoptions) and
-                 assigned(currpara1.defaultconstsym) and
-                 assigned(currpara2.defaultconstsym) then
-               begin
-                 if not equal_constsym(tconstsym(currpara1.defaultconstsym),tconstsym(currpara2.defaultconstsym)) then
-                   exit;
-               end;
-              inc(i1);
-              inc(i2);
-              if cpo_ignorehidden in cpoptions then
-                begin
-                  while (i1<para1.count) and
-                        (vo_is_hidden_para in tparavarsym(para1[i1]).varoptions) do
-                    inc(i1);
-                  while (i2<para2.count) and
-                        (vo_is_hidden_para in tparavarsym(para2[i2]).varoptions) do
-                    inc(i2);
-                end;
-           end;
-         { when both lists are empty then the parameters are equal. Also
-           when one list is empty and the other has a parameter with default
-           value assigned then the parameters are also equal }
-         if ((i1>=para1.count) and (i2>=para2.count)) or
-            ((cpo_allowdefaults in cpoptions) and
-             (((i1<para1.count) and assigned(tparavarsym(para1[i1]).defaultconstsym)) or
-              ((i2<para2.count) and assigned(tparavarsym(para2[i2]).defaultconstsym)))) then
-           compare_paras:=lowesteq;
-      end;
-
-
-    function proc_to_procvar_equal(def1:tabstractprocdef;def2:tprocvardef):tequaltype;
-      var
-        eq : tequaltype;
-        po_comp : tprocoptions;
-      begin
-         proc_to_procvar_equal:=te_incompatible;
-         if not(assigned(def1)) or not(assigned(def2)) then
-           exit;
-         { check for method pointer }
-         if (def1.is_methodpointer xor def2.is_methodpointer) or
-            (def1.is_addressonly xor def2.is_addressonly) then
-           exit;
-         { check return value and options, methodpointer is already checked }
-         po_comp:=[po_staticmethod,po_interrupt,
-                   po_iocheck,po_varargs];
-         if (m_delphi in aktmodeswitches) then
-           exclude(po_comp,po_varargs);
-         if (def1.proccalloption=def2.proccalloption) and
-            ((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) and
-            equal_defs(def1.rettype.def,def2.rettype.def) then
-          begin
-            { return equal type based on the parameters, but a proc->procvar
-              is never exact, so map an exact match of the parameters to
-              te_equal }
-            eq:=compare_paras(def1.paras,def2.paras,cp_procvar,[]);
-            if eq=te_exact then
-             eq:=te_equal;
-            proc_to_procvar_equal:=eq;
-          end;
-      end;
-
-end.